#ifndef GITHASH_PP
#define GITHASH_PP "unknown"
#endif

!> \brief Subroutines that read the various NAMELIST lines in the FDS input file

MODULE READ_INPUT

USE PRECISION_PARAMETERS
USE MESH_VARIABLES
USE GLOBAL_CONSTANTS
USE TRAN
USE MESH_POINTERS
USE OUTPUT_DATA
USE COMP_FUNCTIONS, ONLY: CHECKREAD, SHUTDOWN, CHECK_XB, SCAN_INPUT_FILE
USE MEMORY_FUNCTIONS, ONLY: ChkMemErr,REALLOCATE2D
USE COMP_FUNCTIONS, ONLY: GET_INPUT_FILE
USE MISC_FUNCTIONS, ONLY: SEARCH_CONTROLLER,WRITE_SUMMARY_INFO
USE EVAC, ONLY: READ_EVAC
USE HVAC_ROUTINES, ONLY: READ_HVAC,PROC_HVAC
USE COMPLEX_GEOMETRY, ONLY: READ_GEOM, READ_TRNF, GET_TRNF_INDEX
USE MPI

IMPLICIT NONE
PRIVATE

PUBLIC READ_DATA,READ_STOP,VERSION_INFO

CHARACTER(LABEL_LENGTH) :: ID,MB,DB,ODE_SOLVER
CHARACTER(MESSAGE_LENGTH) :: MESSAGE,FYI
CHARACTER(LABEL_LENGTH) :: SURF_DEFAULT='INERT',EVAC_SURF_DEFAULT='INERT',FUEL_RADCAL_ID='METHANE'
LOGICAL :: EX,THICKEN_OBSTRUCTIONS,BAD,IDEAL=.FALSE.,SIMPLE_FUEL_DEFINED=.FALSE.,TARGET_PARTICLES_INCLUDED=.FALSE.
REAL(EB) :: XB(6),TEXTURE_ORIGIN(3)
REAL(EB) :: PBX,PBY,PBZ
REAL(EB) :: MW_MIN,MW_MAX
REAL(EB) :: REAC_ATOM_ERROR,REAC_MASS_ERROR,HUMIDITY=-1._EB
INTEGER  :: I,J,K,IZERO,IOS,N_INIT_RESERVED,MAX_LEAK_PATHS,I_DUM(10),IERROR,N_CONE_RAMP=0
INTEGER :: FUEL_SMIX_INDEX  ! Simple chemistry fuel index
TYPE(MESH_TYPE), POINTER :: M=>NULL()
TYPE(OBSTRUCTION_TYPE), POINTER :: OB=>NULL()
TYPE(VENTS_TYPE), POINTER :: VT=>NULL()
TYPE(SURFACE_TYPE), POINTER :: SF=>NULL()
TYPE(MATERIAL_TYPE), POINTER :: ML=>NULL()
TYPE(REACTION_TYPE), POINTER :: RN=>NULL()
LOGICAL :: RETURN_BEFORE_STOP_FILE=.FALSE., RETURN_BEFORE_SIM_MODE=.FALSE.

CONTAINS


!> \brief Read the FDS input file

SUBROUTINE READ_DATA(DT)

REAL(EB) :: DT,VEL_CHAR

! Create an array of output QUANTITY names that are included in the various NAMELIST groups

CALL DEFINE_OUTPUT_QUANTITIES

! Get the name of the input file by reading the command line argument

CALL GET_INPUT_FILE

! Stop FDS if the input file cannot be found in the current directory

INQUIRE(FILE=FN_INPUT,EXIST=EX)
IF (.NOT.EX) THEN
   IF (MYID==0) WRITE(LU_ERR,'(A,A,A)') "ERROR: The file, ", TRIM(FN_INPUT),", does not exist in the current directory"
   STOP_STATUS = VERSION_STOP ; RETURN
ENDIF

IF (MYID==0) WRITE(LU_ERR,'(/A/)') ' Reading FDS input file ...'

! Allocate the global orientation vector

N_ORIENTATION_VECTOR = 0
ALLOCATE(ORIENTATION_VECTOR(3,10))

! Set humidity data

CALL CALC_H2O_HV

! Open the input file

OPEN(LU_INPUT,FILE=FN_INPUT,ACTION='READ')

! Read the input file, NAMELIST group by NAMELIST group

CALL READ_CATF    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_DEAD    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_HEAD    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_MISC    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_MOVE    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_MULT    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_MESH(1) ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_EVAC(1) ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_MESH(2) ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_TRAN    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_TIME(DT); CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_PRES    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_COMB    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_REAC    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_SPEC    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_REAC_1  ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_RADI    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_PROP    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_DEVC    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_PART    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_CTRL    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_MATL    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_SURF    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_CSVF    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_OBST    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_GEOM    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_TRNF    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_VENT    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_ZONE    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_EVAC(2) ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_HVAC    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_WIND    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_SURF_1  ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_INIT    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_RAMP    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_SMIX    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_SPEC    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_WIND    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_REAC_2  ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_HVAC    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_MATL    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_SURF_2  ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_DUMP    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_CLIP    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_WALL    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_PART    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_INIT    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_TABL    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_CTRL    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_PROP    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_DEVC    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL PROC_OBST    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_PROF    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_SLCF    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_ISOF    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_BNDF    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN
CALL READ_RADF    ; CALL CHECK_STOP_STATUS ; IF (STOP_STATUS/=NO_STOP) RETURN

! Close the input file, and never open it again

CLOSE (LU_INPUT)

IF (MYID==0 .AND. VERBOSE) WRITE(LU_ERR,'(A)') ' Input file read'

! Set QUANTITY ambient values

CALL SET_QUANTITIES_AMBIENT

! Convert AIT to K

IF (AUTO_IGNITION_TEMPERATURE>0._EB) AUTO_IGNITION_TEMPERATURE = AUTO_IGNITION_TEMPERATURE + TMPM

! Compute the starting time step if the user has not specified it.

IF (DT<=0._EB) THEN
   VEL_CHAR = 0.2_EB*SQRT(10._EB*(ZF_MAX-ZS_MIN))
   IF (ABS(U0)>TWO_EPSILON_EB .OR. ABS(V0)>TWO_EPSILON_EB .OR. ABS(W0)>TWO_EPSILON_EB) &
      VEL_CHAR = MAX(VEL_CHAR,SQRT(U0**2+V0**2+W0**2))
   DT = CFL_MAX*CHARACTERISTIC_CELL_SIZE/VEL_CHAR
ENDIF

CONTAINS

!> \brief Return to main if any MPI processes have hit an ERROR

SUBROUTINE CHECK_STOP_STATUS
INTEGER :: IERR
IF (N_MPI_PROCESSES>1) CALL MPI_ALLREDUCE(MPI_IN_PLACE,STOP_STATUS,INTEGER_ONE,MPI_INTEGER,MPI_MAX,MPI_COMM_WORLD,IERR)
END SUBROUTINE CHECK_STOP_STATUS

END SUBROUTINE READ_DATA


!> \brief Get the name of the input file by reading the command line argument

SUBROUTINE VERSION_INFO
INTEGER :: MPILIBLENGTH,IERR
CHARACTER(LEN=MPI_MAX_LIBRARY_VERSION_STRING) :: MPILIBVERSION

CALL GET_INPUT_FILE

! If no input file is given, just print out the version number and stop

IF (FN_INPUT(1:1)==' ') THEN
   IF (MYID==0) THEN
      CALL WRITE_SUMMARY_INFO(LU_ERR)
      WRITE(LU_ERR,'(A)')  ' Consult FDS Users Guide Chapter, Running FDS, for further instructions.'
   ENDIF
   STOP ! this routine is only called before MPI is initialized so safe to STOP here
ENDIF
IF (FN_INPUT(1:2)=='-V' .OR. FN_INPUT(1:2)=='-v') THEN
   IF (MYID==0) THEN
      CALL MPI_GET_LIBRARY_VERSION(MPILIBVERSION,MPILIBLENGTH,IERR)
      WRITE(LU_ERR,'(A,A)') 'FDS revision       : ',TRIM(GITHASH_PP)
      WRITE(LU_ERR,'(A,A)') 'MPI library version: ',TRIM(MPILIBVERSION)
   ENDIF
   STOP ! this routine is only called before MPI is initialized so safe to STOP here
ENDIF

END SUBROUTINE VERSION_INFO


!> \brief Read the CATF (CATenate File) lines in the FDS input file

SUBROUTINE READ_CATF

INTEGER :: N_CATF_LINES, OFI, TFI
INTEGER, PARAMETER :: LU_CATF2 = 999, LU_STOP1=998, LU_STOP2=997
INTEGER, PARAMETER :: MAX_OTHER_FILES=20 ! Maximum number of fires in the OTHER_FILES namelist field.
CHARACTER(MESSAGE_LENGTH), DIMENSION(MAX_OTHER_FILES) :: OTHER_FILES = 'null'
CHARACTER(MESSAGE_LENGTH) :: BUFFER
CHARACTER(250) :: FN_CATF='null'
INTEGER :: IERR

NAMELIST /CATF/ OTHER_FILES

! First retrieve original CHID:
RETURN_BEFORE_STOP_FILE=.TRUE.
CALL READ_HEAD
RETURN_BEFORE_STOP_FILE=.FALSE.

! Check how many &CATF input lines are being defined:
N_CATF_LINES=0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_OFILES_LOOP1: DO
   CALL CHECKREAD('CATF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_OFILES_LOOP1
   READ(LU_INPUT,'(A)') BUFFER
   N_CATF_LINES = N_CATF_LINES + 1
ENDDO COUNT_OFILES_LOOP1
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
IF (N_CATF_LINES==0) RETURN

! Check that &CATF other files exist:
COUNT_OFILES_LOOP2: DO
   CALL CHECKREAD('CATF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_OFILES_LOOP2
   READ(LU_INPUT,NML=CATF,END=11,ERR=12,IOSTAT=IOS)
   12 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with CATF line') ; RETURN ; ENDIF
   ! OPEN and copy other files into LU_CATF:
   OFI=0
   CPY_LOOP1: DO
      OFI = OFI + 1
      IF(TRIM(OTHER_FILES(OFI))=='null') EXIT CPY_LOOP1
      ! Inquire if other file exists:
      INQUIRE(FILE=TRIM(OTHER_FILES(OFI)),EXIST=EX)
      IF (.NOT.EX) THEN
         WRITE(BUFFER,'(A)') 'ERROR: Problem with CATF line, file '//TRIM(OTHER_FILES(OFI))//' does not exist.'
         CALL SHUTDOWN(TRIM(BUFFER)) ; RETURN
      ENDIF
   ENDDO CPY_LOOP1
ENDDO COUNT_OFILES_LOOP2
11 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! Here at least one &CATF line has been found:
! Open CHID_cat.fds file which will concatenate all input files:
FN_CATF = TRIM(CHID)//'_cat.fds'

! Now check state of OVERWRITE:
RETURN_BEFORE_SIM_MODE=.TRUE.
CALL READ_MISC
RETURN_BEFORE_SIM_MODE=.FALSE.

! Inquire if FN_CATF is present, if so stop to avoid overwriting the input file potentially used previously.
INQUIRE(FILE=TRIM(FN_CATF),EXIST=EX)
IF (EX .AND. .NOT.OVERWRITE) THEN
   WRITE(BUFFER,'(A)') &
   'ERROR: OVERWRITE=.FALSE. and Concatenated file '//TRIM(FN_CATF)//' exists. Also remove '//TRIM(CHID)//'_cat.out'
   CALL SHUTDOWN(TRIM(BUFFER)) ; RETURN
ENDIF

IF (MYID==0) THEN
   OPEN(LU_CATF,FILE=FN_CATF,ACTION='WRITE')
   ! Write new header for LU_CATF:
   WRITE(LU_CATF,'(A)')&
   "&HEAD CHID='"//TRIM(CHID)//"_cat', TITLE='Concatenated : "//TRIM(TITLE)//"', FYI='"//TRIM(FYI)//"' /"

   ! Also, inquire if file TRIM(CHID)//'.stop' exists, if so make a TRIM(CHID)//'_cat.stop' with same contents.
   INQUIRE(FILE=TRIM(CHID)//'.stop',EXIST=EX)
   IF (EX) THEN
      OPEN(LU_STOP1,FILE=TRIM(CHID)//'.stop',STATUS='OLD',ACTION='READ')
      OPEN(LU_STOP2,FILE=TRIM(CHID)//'_cat.stop',STATUS='REPLACE',ACTION='WRITE')
      DO
         READ(LU_STOP1,'(A)',END=20,IOSTAT=IOS) BUFFER
         IF(IOS/=0) EXIT
         WRITE(LU_STOP2,'(A)') TRIM(BUFFER)
      ENDDO
20    CLOSE(LU_STOP1)
      CLOSE(LU_STOP2)
   ENDIF
ENDIF

! Load CHID file into LU_CATF:
CALL COPY_FILE_TO_CAT(LU_INPUT,LU_CATF,0)

IF (N_MPI_PROCESSES > 1) CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

! One &CATF line by one add the corresponding OTHER_FILES into LU_CATF:
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
TFI=0
COPY_OFILES_LOOP: DO
   CALL CHECKREAD('CATF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COPY_OFILES_LOOP
   OTHER_FILES(:) = 'null'
   READ(LU_INPUT,NML=CATF,END=13,ERR=14,IOSTAT=IOS)
   14 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with CATF line') ; RETURN ; ENDIF
   ! OPEN and copy other files into LU_CATF:
   OFI=0
   CPY_LOOP: DO
      TFI = TFI + 1
      OFI = OFI + 1
      IF(TRIM(OTHER_FILES(OFI))=='null') EXIT CPY_LOOP
      ! If it exists open it and copy its contents without the &HEAD line (if any) up to the first &TAIL /
      ! appearance or the EOF.
      OPEN(LU_CATF2,FILE=TRIM(OTHER_FILES(OFI)),ACTION='READ')
      IF (MYID==0) THEN
         IF (TFI>1) WRITE(LU_CATF,'(A)')
         WRITE(LU_CATF,'(A)')'# Start of file '//TRIM(OTHER_FILES(OFI))//' :'
      ENDIF
      CALL COPY_FILE_TO_CAT(LU_CATF2,LU_CATF,OFI)
      CLOSE(LU_CATF2)
   ENDDO CPY_LOOP
ENDDO COPY_OFILES_LOOP
13 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (N_MPI_PROCESSES > 1) CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

! Process 0 closes LU_CATF and reopens FN_CATF as LU_INPUT:
IF (MYID==0) THEN
   WRITE(LU_CATF,'(A)')
   WRITE(LU_CATF,'(A)') '&TAIL /'
   CLOSE(LU_CATF)
ENDIF

IF (N_MPI_PROCESSES > 1) CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

IF (MYID==0) THEN
   CLOSE(LU_INPUT)
   OPEN(LU_INPUT,FILE=FN_CATF,STATUS='OLD',ACTION='READ')
ENDIF

IF (N_MPI_PROCESSES > 1) CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

! Finally other processes reopen FN_CATF as LU_INPUT:
IOS = 0
IF (MYID/=0) THEN
   CLOSE(LU_INPUT)
   TFI = 0
   DO
      TFI = TFI + 1
      IF (TFI > 100) THEN
         IOS=1
         EXIT
      ENDIF
      INQUIRE(FILE=FN_CATF,EXIST=EX)
      IF (EX) THEN
         OPEN(LU_INPUT,FILE=FN_CATF,STATUS='OLD',ACTION='READ')
         EXIT
      ENDIF
      CALL SLEEP(1)
   ENDDO
ENDIF

IF (N_MPI_PROCESSES > 1) CALL MPI_ALLREDUCE(MPI_IN_PLACE,IOS,1,MPI_INTEGER,MPI_MAX,MPI_COMM_WORLD,IERR)
IF (IOS>0) CALL SHUTDOWN('ERROR: Problem Opening CHID_cat.fds file for MPI process /=0.') ; RETURN


RETURN

CONTAINS

!> \brief Copy lines from input ASCII file LU_INFILE handle, to LU_OUTFILE with output handle.  HEAD or CATF lines are skipped.

SUBROUTINE COPY_FILE_TO_CAT(LU_INFILE,LU_OUTFILE,FILENUM)

INTEGER, INTENT(IN) :: LU_INFILE,LU_OUTFILE,FILENUM
INTEGER :: MESSAGE_LENGTH_EXT = 2*MESSAGE_LENGTH
CHARACTER(2*MESSAGE_LENGTH+1) :: BUFFER2 ! This size should be the same as MESSAGE_LENGTH_EXT+1.
COPY_IFILE_LOOP: DO
   ! Non Advancing READ, test if size of record larger than size of BUFFER2 and if end of file:
   READ(LU_INFILE,'(A)',ADVANCE='NO',EOR=11,END=10) BUFFER2
   IF (FILENUM==0) THEN
      WRITE(BUFFER,'(A,I3,A)') 'ERROR: CATF File '//TRIM(CHID)//'.fds has line with > ',MESSAGE_LENGTH_EXT,' characters. Split it.'
   ELSE
      WRITE(BUFFER,'(A,I3,A)') 'ERROR: CATF file '//TRIM(OTHER_FILES(FILENUM))//'.fds has line with > ',&
                               MESSAGE_LENGTH_EXT,' characters. Split it.'
   ENDIF
   CALL SHUTDOWN(BUFFER); RETURN
   ! Advancing READ:
11 CONTINUE
   BACKSPACE(LU_INFILE); READ(LU_INFILE,'(A)') BUFFER2
   IF (BUFFER2(1:5)=='&HEAD') CYCLE COPY_IFILE_LOOP
   IF (BUFFER2(1:5)=='&CATF') CYCLE COPY_IFILE_LOOP
   IF (BUFFER2(1:5)=='&TAIL') EXIT COPY_IFILE_LOOP ! Do not copy the tail line to LU_CATF
   IF(MYID==0) WRITE(LU_OUTFILE,'(A)') TRIM(BUFFER2)
ENDDO COPY_IFILE_LOOP
10 RETURN

END SUBROUTINE COPY_FILE_TO_CAT

END SUBROUTINE READ_CATF


!> \brief Look for deprecated NAMELIST groups.

SUBROUTINE READ_DEAD

CHARACTER(80) :: BAD_TEXT

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL SCAN_INPUT_FILE(LU_INPUT,IOS,BAD_TEXT)
IF (IOS==0) THEN
   WRITE(MESSAGE,'(3A)') 'ERROR: Hidden carriage return character in line starting with: ',BAD_TEXT(2:15),'...'
   CALL SHUTDOWN(MESSAGE)
ENDIF

! Look for outdated NAMELIST groups and stop the run if any are found.

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL CHECKREAD('GRID',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
IF (IOS==0) CALL SHUTDOWN('ERROR: GRID is no longer a valid NAMELIST group. Read User Guide discussion on MESH.')
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL CHECKREAD('HEAT',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
IF (IOS==0) CALL SHUTDOWN('ERROR: HEAT is no longer a valid NAMELIST group. Read User Guide discussion on PROP and DEVC.')
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL CHECKREAD('PDIM',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
IF (IOS==0) CALL SHUTDOWN('ERROR: PDIM is no longer a valid NAMELIST group. Read User Guide discussion on MESH.')
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL CHECKREAD('PIPE',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
IF (IOS==0) CALL SHUTDOWN('ERROR: PIPE is no longer a valid NAMELIST group. Read User Guide discussion on PROP and DEVC.')
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL CHECKREAD('PL3D',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
IF (IOS==0) CALL SHUTDOWN('ERROR: PL3D is no longer a valid NAMELIST group. Read User Guide discussion on DUMP.')
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL CHECKREAD('SMOD',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
IF (IOS==0) CALL SHUTDOWN('ERROR: SMOD is no longer a valid NAMELIST group. Read User Guide discussion on DEVC.')
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL CHECKREAD('SPRK',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
IF (IOS==0) CALL SHUTDOWN('ERROR: SPRK is no longer a valid NAMELIST group. Read User Guide discussion on PROP and DEVC.')
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL CHECKREAD('THCP',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
IF (IOS==0) CALL SHUTDOWN('ERROR: THCP is no longer a valid NAMELIST group. Read User Guide discussion on DEVC.')

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

END SUBROUTINE READ_DEAD


!> \brief Read the HEAD NAMELIST line, which contains the job name

SUBROUTINE READ_HEAD
INTEGER :: NAMELENGTH
NAMELIST /HEAD/ CHID,FYI,TITLE

CHID    = 'null'
TITLE   = '      '
FYI     = '      '

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
HEAD_LOOP: DO
   CALL CHECKREAD('HEAD',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT HEAD_LOOP
   READ(LU_INPUT,HEAD,END=13,ERR=14,IOSTAT=IOS)
   14 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with HEAD line') ; RETURN ; ENDIF
ENDDO HEAD_LOOP
13 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

CLOOP: DO I=1,CHID_LENGTH-1
   IF (CHID(I:I)=='.') THEN ; CALL SHUTDOWN('ERROR: No periods allowed in CHID') ; RETURN ; ENDIF
   IF (CHID(I:I)==' ') EXIT CLOOP
ENDDO CLOOP

IF (TRIM(CHID)=='null') THEN
   NAMELENGTH = LEN_TRIM(FN_INPUT)
   ROOTNAME: DO I=NAMELENGTH,2,-1
      IF (FN_INPUT(I:I)=='.') THEN
         WRITE(CHID,'(A)') FN_INPUT(1:I-1)
         EXIT ROOTNAME
      ENDIF
   END DO ROOTNAME
ENDIF

IF (RETURN_BEFORE_STOP_FILE) RETURN

! Define and look for a stop file

FN_STOP = TRIM(CHID)//'.stop'
INQUIRE(FILE=FN_STOP,EXIST=EX)
IF (EX) THEN
   STOP_AT_ITER=READ_STOP() ! READ_STOP() returns 0 if there is nothing in the .stop file
   IF (STOP_AT_ITER<=0) THEN
      WRITE(MESSAGE,'(A,A,A)') "ERROR: Remove the file, ",TRIM(FN_STOP),", from the current directory"
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ELSE
      WRITE(LU_ERR,'(A,A,A)') "NOTE: The file, ",TRIM(FN_STOP),", was detected."
      WRITE(LU_ERR,'(A,I3,A)')"This FDS run will stop after ",STOP_AT_ITER," iterations."
   ENDIF
ENDIF

END SUBROUTINE READ_HEAD


!> \brief If a stop file exists and contains a positive integer, stop the fds run when it computes that number of iterations

INTEGER FUNCTION READ_STOP()

   READ_STOP=0

   OPEN(UNIT=LU_STOP,FILE=FN_STOP,FORM='FORMATTED',STATUS='OLD',IOSTAT=IERROR)
   IF (IERROR==0) THEN
      READ(LU_STOP,'(I5)',END=10,IOSTAT=IERROR) READ_STOP
      IF (IERROR/=0) READ_STOP=0
   ENDIF
10 CLOSE(LU_STOP)

END FUNCTION READ_STOP


!> \brief Read the MESH namelist lines

SUBROUTINE READ_MESH(IMODE)

USE GLOBAL_CONSTANTS, ONLY : OPENMP_USED_THREADS, OPENMP_USER_SET_THREADS, USE_OPENMP
USE COMP_FUNCTIONS, ONLY : SEARCH_INPUT_FILE
USE EVAC, ONLY: N_DOORS, N_EXITS, N_CO_EXITS, EVAC_EMESH_EXITS_TYPE, EMESH_EXITS, EMESH_ID, EMESH_IJK, EMESH_XB, &
                EMESH_NM, N_DOOR_MESHES, EMESH_NFIELDS, HUMAN_SMOKE_HEIGHT, EVAC_DELTA_SEE, &
                EMESH_STAIRS, EVAC_EMESH_STAIRS_TYPE, N_STRS, INPUT_EVAC_GRIDS, NO_EVAC_MESHES
INTEGER, INTENT(IN) :: IMODE
INTEGER :: IJK(3),NM,NM2,CURRENT_MPI_PROCESS,MPI_PROCESS,RGB(3),LEVEL,N_MESH_NEW,N,II,JJ,KK,NMESHES_READ,NNN,NEVAC_MESHES, &
           NMESHES_EVAC, NMESHES_FIRE, NM_EVAC, N_THREADS, JBAR_OLD_VALUE
INTEGER, ALLOCATABLE, DIMENSION(:) :: NEIGHBOR_LIST
LOGICAL :: EVACUATION, EVAC_HUMANS,OVERLAPPING_X,OVERLAPPING_Y,OVERLAPPING_Z,POSSIBLY_PERIODIC,CYLINDRICAL_OLD_VALUE, &
           PERIODIC_FOUND_IN_FILE
REAL(EB) :: EVAC_Z_OFFSET,XB1,XB2,XB3,XB4,XB5,XB6
CHARACTER(25) :: COLOR
CHARACTER(LABEL_LENGTH) :: MULT_ID,TRNX_ID,TRNY_ID,TRNZ_ID
NAMELIST /MESH/ CHECK_MESH_ALIGNMENT,COLOR,CYLINDRICAL,EVACUATION,EVAC_HUMANS,EVAC_Z_OFFSET, FYI,ID,IJK,LEVEL,MPI_PROCESS,MULT_ID,&
                N_THREADS,RGB,TRNX_ID,TRNY_ID,TRNZ_ID,XB
TYPE (MESH_TYPE), POINTER :: M,M2
TYPE (MULTIPLIER_TYPE), POINTER :: MR

NMESHES = 0
NMESHES_READ = 0
NMESHES_EVAC = 0
NMESHES_FIRE = 0
NEVAC_MESHES = 0
CYLINDRICAL_OLD_VALUE = .FALSE.
JBAR_OLD_VALUE = 0
IF (IMODE==1) THEN
   NO_EVAC_MESHES = .TRUE.
   INPUT_EVAC_GRIDS   = 0
   IF(NO_EVACUATION) THEN
      N_EVAC = 0
      RETURN
   END IF
END IF

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_MESH_LOOP: DO
   CALL CHECKREAD('MESH',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_MESH_LOOP
   MULT_ID = 'null'
   EVACUATION  = .FALSE.
   EVAC_HUMANS  = .FALSE.
   READ(LU_INPUT,MESH,END=15,ERR=16,IOSTAT=IOS)
   NMESHES_READ = NMESHES_READ + 1
   IF (NMESHES_READ>1 .AND. ((CYLINDRICAL_OLD_VALUE.NEQV.CYLINDRICAL) .OR. (IJK(2)==1).NEQV.(JBAR_OLD_VALUE==1))) THEN
      WRITE(MESSAGE,'(A,A,A,I0)') 'ERROR: All meshes must be CYLINDRICAL and/or all meshes must have IJK(2) set to 1'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ELSE
      CYLINDRICAL_OLD_VALUE = CYLINDRICAL
      JBAR_OLD_VALUE = IJK(2)
   ENDIF
   IF (NO_EVACUATION .AND. EVACUATION) CYCLE COUNT_MESH_LOOP ! skip evacuation meshes
   IF (EVACUATION_DRILL .AND. .NOT.EVACUATION) CYCLE COUNT_MESH_LOOP ! skip fire meshes
   IF (EVACUATION_MC_MODE .AND. .NOT.EVACUATION) CYCLE COUNT_MESH_LOOP ! skip fire meshes
   IF (EVACUATION) NEVAC_MESHES = NEVAC_MESHES + 1
   IF (IMODE==1 .AND. EVAC_HUMANS) NO_EVAC_MESHES = .FALSE.
   IF (IMODE==1 .AND. EVAC_HUMANS) INPUT_EVAC_GRIDS = INPUT_EVAC_GRIDS + 1
   N_MESH_NEW = 0
   IF (MULT_ID=='null') THEN
      N_MESH_NEW = 1
   ELSE
      DO N=1,N_MULT
         MR => MULTIPLIER(N)
         IF (MULT_ID==MR%ID) N_MESH_NEW = MR%N_COPIES
      ENDDO
      IF (N_MESH_NEW==0) THEN
         WRITE(MESSAGE,'(A,A,A,I0)') 'ERROR: MULT line ', TRIM(MULT_ID),' not found on MESH line', &
            NMESHES_READ
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF
   NMESHES      = NMESHES + N_MESH_NEW
   IF (.NOT.EVACUATION) NMESHES_FIRE =  NMESHES_FIRE + N_MESH_NEW
16 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0)') 'ERROR: Problem with MESH line, line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

ENDDO COUNT_MESH_LOOP
15 CONTINUE

EVAC_MODE_IF: IF (IMODE==1) THEN
   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   IF (NO_EVAC_MESHES) THEN
      NO_EVACUATION      = .TRUE.
      EVACUATION_DRILL   = .FALSE.
      EVACUATION_MC_MODE = .FALSE.
      N_EVAC             = 0
      RETURN
   END IF
   ALLOCATE(EMESH_ID(     MAX(1,INPUT_EVAC_GRIDS)), STAT=IZERO)
   CALL ChkMemErr('READ_EVAC','EMESH_ID',IZERO)
   ALLOCATE(EMESH_XB(6,   MAX(1,INPUT_EVAC_GRIDS)), STAT=IZERO)
   CALL ChkMemErr('READ_EVAC','EMESH_XB',IZERO)
   ALLOCATE(EMESH_IJK(3,  MAX(1,INPUT_EVAC_GRIDS)), STAT=IZERO)
   CALL ChkMemErr('READ_EVAC','EMESH_IJK',IZERO)

   NM = 0
   EVAC_MESH_LOOP: DO N = 1, NMESHES_READ
      ! Set evacuation MESH defaults
      IJK(1)= 10
      IJK(2)= 10
      IJK(3)= 1
      XB(1) = 0._EB
      XB(2) = 1._EB
      XB(3) = 0._EB
      XB(4) = 1._EB
      XB(5) = 0._EB
      XB(6) = 1._EB
      RGB   = -1
      COLOR   = 'null'
      ID      = 'null'
      EVACUATION  = .FALSE.
      EVAC_HUMANS = .FALSE.
      ! Read the MESH line
      CALL CHECKREAD('MESH', LU_INPUT, IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT EVAC_MESH_LOOP
      READ(LU_INPUT, MESH)
      IF (.NOT.EVACUATION)                   CYCLE EVAC_MESH_LOOP ! skip fire meshes
      IF (.NOT.EVAC_HUMANS .AND. EVACUATION) CYCLE EVAC_MESH_LOOP ! skip additional evac meshes
      NM = NM + 1
      ! Reorder XB coordinates if necessary
      CALL CHECK_XB(XB)
      EMESH_ID(NM)    = TRIM(ID)
      EMESH_IJK(1,NM) = IJK(1)
      EMESH_IJK(2,NM) = IJK(2)
      EMESH_IJK(3,NM) = IJK(3)
      EMESH_XB(1,NM)  = XB(1)
      EMESH_XB(2,NM)  = XB(2)
      EMESH_XB(3,NM)  = XB(3)
      EMESH_XB(4,NM)  = XB(4)
      EMESH_XB(5,NM)  = XB(5)
      EMESH_XB(6,NM)  = XB(6)
   END DO EVAC_MESH_LOOP
   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   RETURN
END IF EVAC_MODE_IF

IF (.NOT. NO_EVACUATION) NMESHES = NMESHES + N_DOOR_MESHES + NEVAC_MESHES
IF (.NOT. NO_EVACUATION) NMESHES = NMESHES + N_STRS

NMESHES_EVAC = NMESHES - NMESHES_FIRE

! Stop the calculation if the number of MPI processes is greater than the number of meshes

IF (NO_EVACUATION) THEN
   IF (NMESHES<N_MPI_PROCESSES) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: The number of MPI processes, ',N_MPI_PROCESSES,', exceeds the number of meshes, ',NMESHES
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ELSE
   IF(NMESHES_FIRE+1<N_MPI_PROCESSES) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: The number of MPI processes, ',N_MPI_PROCESSES,&
           ', exceeds the number of fire meshes + 1, ',NMESHES_FIRE+1
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDIF

! Allocate parameters associated with the mesh.

ALLOCATE(MESHES(NMESHES),STAT=IZERO) ; CALL ChkMemErr('READ','MESHES',IZERO)
ALLOCATE(PROCESS(NMESHES),STAT=IZERO) ; CALL ChkMemErr('READ','PROCESS',IZERO)
ALLOCATE(MESH_NAME(NMESHES),STAT=IZERO) ; CALL ChkMemErr('READ','MESH_NAME',IZERO)
ALLOCATE(CHANGE_TIME_STEP_INDEX(NMESHES),STAT=IZERO) ; CALL ChkMemErr('READ','CHANGE_TIME_STEP_INDEX',IZERO)
CHANGE_TIME_STEP_INDEX = 0
ALLOCATE(SETUP_PRESSURE_ZONES_INDEX(NMESHES),STAT=IZERO) ; CALL ChkMemErr('READ','SETUP_PRESSURE_ZONES_INDEX',IZERO)
SETUP_PRESSURE_ZONES_INDEX = 0
ALLOCATE(EVACUATION_ONLY(NMESHES),STAT=IZERO) ; CALL ChkMemErr('READ','EVACUATION_ONLY',IZERO)
EVACUATION_ONLY(1:NMESHES_FIRE) = .FALSE.
IF (NMESHES_FIRE<NMESHES) EVACUATION_ONLY(NMESHES_FIRE+1:NMESHES) = .TRUE.
ALLOCATE(EVACUATION_SKIP(NMESHES),STAT=IZERO) ; CALL ChkMemErr('READ','EVACUATION_SKIP',IZERO)
EVACUATION_SKIP = .FALSE.
ALLOCATE(EVACUATION_Z_OFFSET(NMESHES),STAT=IZERO) ; CALL ChkMemErr('READ','EVACUATION_Z_OFFSET',IZERO)
EVACUATION_Z_OFFSET = 1.0_EB
ALLOCATE(RADIATION_COMPLETED(NMESHES),STAT=IZERO) ; CALL ChkMemErr('READ','RADIATION_COMPLETED',IZERO) ; RADIATION_COMPLETED=.TRUE.

! Read in the Mesh lines from Input file

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (NMESHES<1) THEN ; CALL SHUTDOWN('ERROR: No MESH line(s) defined.') ; RETURN ; ENDIF

NM = 0

MESH_LOOP: DO N=1,NMESHES_READ

   ! Set MESH defaults

   IJK(1)= 10
   IJK(2)= 10
   IJK(3)= 10
   XB(1) = 0._EB
   XB(2) = 1._EB
   XB(3) = 0._EB
   XB(4) = 1._EB
   XB(5) = 0._EB
   XB(6) = 1._EB
   RGB   = -1
   COLOR = 'null'
   ID = 'null'
   EVACUATION  = .FALSE.
   EVAC_Z_OFFSET = 1.0_EB
   EVAC_HUMANS = .FALSE.
   MPI_PROCESS = -1
   LEVEL = 0
   MULT_ID = 'null'
   TRNX_ID = 'null'
   TRNY_ID = 'null'
   TRNZ_ID = 'null'
   N_THREADS = -1

   ! Read the MESH line

   CALL CHECKREAD('MESH',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT MESH_LOOP
   READ(LU_INPUT,MESH)

   IF (NO_EVACUATION .AND. EVACUATION) CYCLE MESH_LOOP ! skip evacuation meshes
   IF (EVACUATION_DRILL .AND. .NOT.EVACUATION) CYCLE MESH_LOOP ! skip fire meshes
   IF (EVACUATION_MC_MODE .AND. .NOT.EVACUATION) CYCLE MESH_LOOP ! skip fire meshes

   ! Reorder XB coordinates if necessary

   CALL CHECK_XB(XB)

   ! Multiply meshes if need be

   MR => MULTIPLIER(0)
   DO NNN=1,N_MULT
      IF (MULT_ID==MULTIPLIER(NNN)%ID) MR => MULTIPLIER(NNN)
   ENDDO

   K_MULT_LOOP: DO KK=MR%K_LOWER,MR%K_UPPER
      J_MULT_LOOP: DO JJ=MR%J_LOWER,MR%J_UPPER
         I_MULT_LOOP: DO II=MR%I_LOWER,MR%I_UPPER

            IF (MR%SKIP(II,JJ,KK)) CYCLE I_MULT_LOOP

            IF (.NOT.MR%SEQUENTIAL) THEN
               XB1 = XB(1) + MR%DX0 + II*MR%DXB(1)
               XB2 = XB(2) + MR%DX0 + II*MR%DXB(2)
               XB3 = XB(3) + MR%DY0 + JJ*MR%DXB(3)
               XB4 = XB(4) + MR%DY0 + JJ*MR%DXB(4)
               XB5 = XB(5) + MR%DZ0 + KK*MR%DXB(5)
               XB6 = XB(6) + MR%DZ0 + KK*MR%DXB(6)
            ELSE
               XB1 = XB(1) + MR%DX0 + II*MR%DXB(1)
               XB2 = XB(2) + MR%DX0 + II*MR%DXB(2)
               XB3 = XB(3) + MR%DY0 + II*MR%DXB(3)
               XB4 = XB(4) + MR%DY0 + II*MR%DXB(4)
               XB5 = XB(5) + MR%DZ0 + II*MR%DXB(5)
               XB6 = XB(6) + MR%DZ0 + II*MR%DXB(6)
            ENDIF

            ! Increase the MESH counter by 1

            NM = NM + 1

            ! Determine which PROCESS to assign the MESH to

            IF (MPI_PROCESS>-1) THEN
               CURRENT_MPI_PROCESS = MPI_PROCESS
               IF (CURRENT_MPI_PROCESS>N_MPI_PROCESSES-1) THEN
                  IF (N_MPI_PROCESSES > 1) THEN
                     WRITE(MESSAGE,'(A,I0,A)') 'ERROR: MPI_PROCESS for MESH ',NM,' greater than total number of processes'
                     CALL SHUTDOWN(MESSAGE) ; RETURN
                  ELSE
                     ! Prevents fatal error when testing a run on a single core with MPI_PROCESS set for meshes
                     WRITE(MESSAGE,'(A,I0,A)') 'WARNING: MPI_PROCESS set for MESH ',NM,' and only one MPI process exists'
                     IF (MYID==0) WRITE(LU_ERR,'(A)') TRIM(MESSAGE)
                     CURRENT_MPI_PROCESS=0
                  ENDIF
               ENDIF
            ELSE
               CURRENT_MPI_PROCESS = MIN(NM-1,N_MPI_PROCESSES-1)
            ENDIF

            ! Fill in MESH related variables

            M => MESHES(NM)
            M%TRNX_ID = TRNX_ID
            M%TRNY_ID = TRNY_ID
            M%TRNZ_ID = TRNZ_ID
            M%MESH_LEVEL = LEVEL
            M%IBAR = IJK(1)
            M%JBAR = IJK(2)
            M%KBAR = IJK(3)
            IBAR_MAX = MAX(IBAR_MAX,M%IBAR)
            JBAR_MAX = MAX(JBAR_MAX,M%JBAR)
            KBAR_MAX = MAX(KBAR_MAX,M%KBAR)
            M%N_EXTERNAL_WALL_CELLS = 2*M%IBAR*M%JBAR+2*M%IBAR*M%KBAR+2*M%JBAR*M%KBAR

            IF (EVACUATION)  EVACUATION_ONLY(NM) = .TRUE.
            IF (EVAC_HUMANS) EVACUATION_SKIP(NM) = .TRUE.
            IF (EVACUATION)  EVACUATION_Z_OFFSET(NM) = EVAC_Z_OFFSET
            IF (EVACUATION)  M%N_EXTERNAL_WALL_CELLS = 2*M%IBAR*M%KBAR+2*M%JBAR*M%KBAR
            IF (EVACUATION .AND. .NOT.EVAC_HUMANS) THEN
               WRITE(MESSAGE,'(A)') 'ERROR: NO DOOR FLOW EVACUATION MESHES IN FDS6'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF

            IF (M%JBAR==1) TWO_D = .TRUE.
            IF (TWO_D .AND. M%JBAR/=1) THEN
               WRITE(MESSAGE,'(A)') 'ERROR: IJK(2) must be 1 for all grids in 2D Calculation'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (EVACUATION .AND. M%KBAR/=1) THEN
               WRITE(MESSAGE,'(A)') 'ERROR: IJK(3) must be 1 for all evacuation grids'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF

            ! Associate the MESH with the PROCESS

            IF (MYID==CURRENT_MPI_PROCESS) THEN
               LOWER_MESH_INDEX = MIN(LOWER_MESH_INDEX,NM)
               UPPER_MESH_INDEX = MAX(UPPER_MESH_INDEX,NM)
            ENDIF

            PROCESS(NM) = CURRENT_MPI_PROCESS
            IF (MYID==0 .AND. VERBOSE) &
               WRITE(LU_ERR,'(A,I0,A,I0)') ' Mesh ',NM,' is assigned to MPI Process ',PROCESS(NM)
            IF (EVACUATION_ONLY(NM) .AND. (N_MPI_PROCESSES>1)) EVAC_PROCESS = N_MPI_PROCESSES-1

            ! Check the number of OMP threads for a valid value (positive, larger than 0), -1 indicates default unchanged value
            IF (N_THREADS < 1 .AND. N_THREADS /= -1) THEN
               WRITE(MESSAGE, '(A)') 'ERROR: N_THREADS must be at least 1'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF

            ! If OMP number of threads is explicitly set for this mesh and the mesh is assigned to this MPI process,
            ! then set this value
            IF (MYID == PROCESS(NM) .AND. N_THREADS > 0) THEN
               ! Check if OPENMP is active
               IF (USE_OPENMP .NEQV. .TRUE.) THEN
                  WRITE(MESSAGE, '(A)') 'ERROR: setting N_THREADS, but OPENMP is not active'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               END IF

               ! Check if the process' thread number was already set in a previous mesh definition
               IF (OPENMP_USER_SET_THREADS .EQV. .TRUE.) THEN
                  ! Check if previous definitions are consistent
                  IF (N_THREADS .NE. OPENMP_USED_THREADS) THEN
                     WRITE(MESSAGE, '(A)') 'ERROR: N_THREADS not consistent for MPI process'
                     CALL SHUTDOWN(MESSAGE) ; RETURN
                  END IF
               END IF

               ! set the value-changed-flag and the new thread number
               OPENMP_USER_SET_THREADS = .TRUE.
               OPENMP_USED_THREADS     = N_THREADS
            END IF

            ! Mesh boundary colors

            IF (ANY(RGB<0) .AND. COLOR=='null') COLOR = 'BLACK'
            IF (COLOR /= 'null') CALL COLOR2RGB(RGB,COLOR)
            ALLOCATE(M%RGB(3))
            M%RGB = RGB

            ! Mesh Geometry and Name

            WRITE(MESH_NAME(NM),'(A,I7.7)') 'MESH_',NM
            IF (ID/='null') MESH_NAME(NM) = ID

            ! Process Physical Coordinates

            IF (XB2-XB1<TWO_EPSILON_EB) THEN
               WRITE(MESSAGE,'(A,I0)') 'ERROR: XMIN > XMAX on MESH ', NM
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (XB4-XB3<TWO_EPSILON_EB) THEN
               WRITE(MESSAGE,'(A,I0)') 'ERROR: YMIN > YMAX on MESH ', NM
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (XB6-XB5<TWO_EPSILON_EB) THEN
               WRITE(MESSAGE,'(A,I0)') 'ERROR: ZMIN > ZMAX on MESH ', NM
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (EVACUATION .AND. ABS(XB5 - XB6) <= SPACING(XB(6))) THEN
               WRITE(MESSAGE,'(A,I0)') 'ERROR: ZMIN = ZMAX on evacuation MESH ', NM
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (CYLINDRICAL .AND. XB1<-TWO_EPSILON_EB) THEN
               WRITE(MESSAGE,'(A,I0)') 'ERROR: XMIN < 0 with CYLINDRICAL on MESH ', NM
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (CYLINDRICAL .AND. .NOT.TWO_D) THEN
               WRITE(MESSAGE,'(A,I0)') 'ERROR: J>1 with CYLINDRICAL on MESH ', NM
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF

            M%XS    = XB1
            M%XF    = XB2
            M%YS    = XB3
            M%YF    = XB4
            M%ZS    = XB5
            M%ZF    = XB6
            IF (.NOT.EVACUATION ) THEN
               XS_MIN  = MIN(XS_MIN,M%XS)
               XF_MAX  = MAX(XF_MAX,M%XF)
               YS_MIN  = MIN(YS_MIN,M%YS)
               YF_MAX  = MAX(YF_MAX,M%YF)
               ZS_MIN  = MIN(ZS_MIN,M%ZS)
               ZF_MAX  = MAX(ZF_MAX,M%ZF)
            ENDIF
            M%DXI   = (M%XF-M%XS)/REAL(M%IBAR,EB)
            M%DETA  = (M%YF-M%YS)/REAL(M%JBAR,EB)
            M%DZETA = (M%ZF-M%ZS)/REAL(M%KBAR,EB)
            M%RDXI  = 1._EB/M%DXI
            M%RDETA = 1._EB/M%DETA
            M%RDZETA= 1._EB/M%DZETA
            M%IBM1  = M%IBAR-1
            M%JBM1  = M%JBAR-1
            M%KBM1  = M%KBAR-1
            M%IBP1  = M%IBAR+1
            M%JBP1  = M%JBAR+1
            M%KBP1  = M%KBAR+1

            IF (TWO_D) THEN
               M%CELL_SIZE = SQRT(M%DXI*M%DZETA)
            ELSE
               M%CELL_SIZE = (M%DXI*M%DETA*M%DZETA)**ONTH
            ENDIF

            IF (.NOT.EVACUATION_ONLY(NM)) CHARACTERISTIC_CELL_SIZE = MIN( CHARACTERISTIC_CELL_SIZE , M%CELL_SIZE )

         ENDDO I_MULT_LOOP
      ENDDO J_MULT_LOOP
   ENDDO K_MULT_LOOP

ENDDO MESH_LOOP

NM_EVAC = NM
IF (ANY(EVACUATION_ONLY)) THEN
   DO NM=1,NMESHES
      IF(EVACUATION_ONLY(NM)) PROCESS(NM)=MAX(0,EVAC_PROCESS)
   ENDDO
ENDIF


! Check if there are too many MPI processes assigned to the job

IF (PROCESS(NMESHES) < N_MPI_PROCESSES-1) THEN
   WRITE(MESSAGE,'(A)') 'ERROR: Too many MPI processes have been assigned to this job'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

! Check for bad mesh ordering if MPI_PROCESS used

DO NM=1,NMESHES
   IF (NM==1) CYCLE
   IF (EVACUATION_ONLY(NM)) CYCLE
   IF (PROCESS(NM) < PROCESS(NM-1)) THEN
      WRITE(MESSAGE,'(A,I0,A,I0,A)') 'ERROR: MPI_PROCESS for MESH ', NM,' < MPI_PROCESS for MESH ',NM-1,&
                                     '. Reorder MESH lines.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDDO
DO NM=1,NMESHES
   IF (NM==1 .OR. .NOT.EVACUATION_ONLY(NM)) CYCLE
   IF (.NOT.EVACUATION_SKIP(NM)) CYCLE
   IF (PROCESS(NM) < PROCESS(NM-1)) THEN
      WRITE(MESSAGE,'(A,I0,A,I0,A)') 'ERROR: MPI_PROCESS for evacuation MESH ', NM,' < MPI_PROCESS for MESH ',NM-1,&
                                     '. Reorder MESH lines.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDDO

! Define the additional evacuation door flow meshes

!Timo: Mesh counter NM_EVAC is now fire meshes plus main evac meshes
IF (.NOT. NO_EVACUATION) CALL DEFINE_EVACUATION_MESHES(NM_EVAC)

! Determine mesh neighbors. MESH_SEPARATION_DISTANCE is a very small distance
! beyond which two meshes are considered separate. NEIGHBOR_SEPARATION_DISANCE
! is the distance beyond which no information or message passing is assumed
! between the meshes.

MESH_SEPARATION_DISTANCE = MIN(1.E-3_EB,0.05_EB*CHARACTERISTIC_CELL_SIZE)
NEIGHBOR_SEPARATION_DISTANCE = 5._EB*CHARACTERISTIC_CELL_SIZE

! Search through the input file for any mention of the word PERIODIC. If not found, this simplifies neighbor selection.

CALL SEARCH_INPUT_FILE(LU_INPUT,'PERIODIC',PERIODIC_FOUND_IN_FILE)

! For MESHES controlled by a given MPI process, only allocate other MESHES that
! are "close" as defined by the two parameters above.

ALLOCATE(NEIGHBOR_LIST(10000))

DO NM=1,NMESHES
   M => MESHES(NM)
   M%N_NEIGHBORING_MESHES = 0
   NEIGHBOR_LIST = 0
   DO NM2=1,NMESHES
      IF(NM/=NM2 .AND. EVACUATION_ONLY(NM2)) CYCLE
      M2 => MESHES(NM2)
      OVERLAPPING_X = .TRUE.
      OVERLAPPING_Y = .TRUE.
      OVERLAPPING_Z = .TRUE.
      POSSIBLY_PERIODIC = .FALSE.
      IF (M2%XS>M%XF+NEIGHBOR_SEPARATION_DISTANCE .OR. M2%XF<M%XS-NEIGHBOR_SEPARATION_DISTANCE) OVERLAPPING_X = .FALSE.
      IF (M2%YS>M%YF+NEIGHBOR_SEPARATION_DISTANCE .OR. M2%YF<M%YS-NEIGHBOR_SEPARATION_DISTANCE) OVERLAPPING_Y = .FALSE.
      IF (M2%ZS>M%ZF+NEIGHBOR_SEPARATION_DISTANCE .OR. M2%ZF<M%ZS-NEIGHBOR_SEPARATION_DISTANCE) OVERLAPPING_Z = .FALSE.
      IF (((ABS(M2%XS-XS_MIN)<MESH_SEPARATION_DISTANCE .AND. ABS( M%XF-XF_MAX)<MESH_SEPARATION_DISTANCE)  .OR.  &
           (ABS( M%XS-XS_MIN)<MESH_SEPARATION_DISTANCE .AND. ABS(M2%XF-XF_MAX)<MESH_SEPARATION_DISTANCE)) .AND. &
          OVERLAPPING_Y .AND. OVERLAPPING_Z) POSSIBLY_PERIODIC = .TRUE.
      IF (((ABS(M2%YS-YS_MIN)<MESH_SEPARATION_DISTANCE .AND. ABS( M%YF-YF_MAX)<MESH_SEPARATION_DISTANCE)  .OR.  &
           (ABS( M%YS-YS_MIN)<MESH_SEPARATION_DISTANCE .AND. ABS(M2%YF-YF_MAX)<MESH_SEPARATION_DISTANCE)) .AND. &
          OVERLAPPING_X .AND. OVERLAPPING_Z) POSSIBLY_PERIODIC = .TRUE.
      IF (((ABS(M2%ZS-ZS_MIN)<MESH_SEPARATION_DISTANCE .AND. ABS( M%ZF-ZF_MAX)<MESH_SEPARATION_DISTANCE)  .OR.  &
           (ABS( M%ZS-ZS_MIN)<MESH_SEPARATION_DISTANCE .AND. ABS(M2%ZF-ZF_MAX)<MESH_SEPARATION_DISTANCE)) .AND. &
          OVERLAPPING_X .AND. OVERLAPPING_Y) POSSIBLY_PERIODIC = .TRUE.
      IF (.NOT.PERIODIC_FOUND_IN_FILE) POSSIBLY_PERIODIC = .FALSE.
      IF ((.NOT.OVERLAPPING_X .OR. .NOT.OVERLAPPING_Y .OR. .NOT.OVERLAPPING_Z) .AND. .NOT.POSSIBLY_PERIODIC) CYCLE
      M%N_NEIGHBORING_MESHES = M%N_NEIGHBORING_MESHES + 1
      NEIGHBOR_LIST(M%N_NEIGHBORING_MESHES) = NM2
   ENDDO
   ALLOCATE(M%NEIGHBORING_MESH(M%N_NEIGHBORING_MESHES))
   DO I=1,M%N_NEIGHBORING_MESHES
      M%NEIGHBORING_MESH(I) = NEIGHBOR_LIST(I)
   ENDDO
ENDDO
DEALLOCATE(NEIGHBOR_LIST)

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

CONTAINS


!> \brief Create EVACuation MESHes

SUBROUTINE DEFINE_EVACUATION_MESHES(NM)

IMPLICIT NONE
INTEGER, INTENT(INOUT) :: NM
INTEGER :: N, N_END, I, J, NN, JMAX, NM_OLD, I_MAIN_EVAC_MESH
REAL(EB) :: Z_MID

N = 0
DO I = 1, NM
   IF (EVACUATION_SKIP(I) .AND. EVACUATION_ONLY(I)) THEN
      N = N + 1 ! Main evacuation mesh index for EMESH_EXITS(N) array
      EMESH_NM(N) = I
   END IF
END DO

NM_OLD = NM
LOOP_EMESHES: DO N = 1, NEVAC_MESHES
   ! Additional meshes for the main evacuation meshes. These will be
   ! at different z level than the corresponding main evacuation mesh.

   I_MAIN_EVAC_MESH = NM_OLD - NEVAC_MESHES + N

   ! Set MESH defaults

   RGB   = MESHES(I_MAIN_EVAC_MESH)%RGB
   COLOR = 'null'
   ID = TRIM(TRIM('Emesh_' // MESH_NAME(I_MAIN_EVAC_MESH)))
   MPI_PROCESS = -1
   LEVEL = 0
   EVACUATION = .TRUE.
   EVAC_HUMANS = .FALSE.

   ! Increase the MESH counter by 1

   NM = NM + 1

   ! Fill in MESH related variables

   M => MESHES(NM)
   M%MESH_LEVEL = LEVEL
   M%IBAR = MESHES(I_MAIN_EVAC_MESH)%IBAR
   M%JBAR = MESHES(I_MAIN_EVAC_MESH)%JBAR
   M%KBAR = MESHES(I_MAIN_EVAC_MESH)%KBAR
   IBAR_MAX = MAX(IBAR_MAX,M%IBAR)
   JBAR_MAX = MAX(JBAR_MAX,M%JBAR)
   KBAR_MAX = MAX(KBAR_MAX,M%KBAR)
   EVACUATION_ONLY(NM) = .TRUE.
   EVACUATION_SKIP(NM) = .FALSE.
   EVACUATION_Z_OFFSET(NM) = EVAC_Z_OFFSET ! Not used, this line is not needed
   M%N_EXTERNAL_WALL_CELLS = 2*M%IBAR*M%KBAR+2*M%JBAR*M%KBAR
   IF (EVACUATION .AND. M%KBAR/=1) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: IJK(3) must be 1 for all evacuation grids'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Associate the MESH with the PROCESS

   IF (MYID==CURRENT_MPI_PROCESS) THEN
      LOWER_MESH_INDEX = MIN(LOWER_MESH_INDEX,NM)
      UPPER_MESH_INDEX = MAX(UPPER_MESH_INDEX,NM)
   ENDIF

   PROCESS(NM) = CURRENT_MPI_PROCESS
   IF (MYID==0 .AND. VERBOSE) WRITE(LU_ERR,'(A,I0,A,I0)') ' Mesh ',NM,' is assigned to MPI Process ',PROCESS(NM)
   IF (EVACUATION_ONLY(NM) .AND. (N_MPI_PROCESSES>1)) EVAC_PROCESS = N_MPI_PROCESSES-1

   ! Mesh boundary colors

   IF (ANY(RGB<0) .AND. COLOR=='null') COLOR = 'BLACK'
   IF (COLOR /= 'null') CALL COLOR2RGB(RGB,COLOR)
   ALLOCATE(M%RGB(3))
   M%RGB = RGB

   ! Mesh Geometry and Name

   WRITE(MESH_NAME(NM),'(A,I7.7)') 'MESH_',NM
   IF (ID/='null') MESH_NAME(NM) = ID

   Z_MID = 0.5_EB*(MESHES(I_MAIN_EVAC_MESH)%ZS + MESHES(I_MAIN_EVAC_MESH)%ZF)
   Z_MID = Z_MID - EVACUATION_Z_OFFSET(I_MAIN_EVAC_MESH)  + HUMAN_SMOKE_HEIGHT
   M%XS    = MESHES(I_MAIN_EVAC_MESH)%XS
   M%XF    = MESHES(I_MAIN_EVAC_MESH)%XF
   M%YS    = MESHES(I_MAIN_EVAC_MESH)%YS
   M%YF    = MESHES(I_MAIN_EVAC_MESH)%YF
   M%ZS    = Z_MID - EVAC_DELTA_SEE
   M%ZF    = Z_MID + EVAC_DELTA_SEE
   M%DXI   = MESHES(I_MAIN_EVAC_MESH)%DXI
   M%DETA  = MESHES(I_MAIN_EVAC_MESH)%DETA
   M%DZETA = (M%ZF-M%ZS)/REAL(M%KBAR,EB)
   M%RDXI  = MESHES(I_MAIN_EVAC_MESH)%RDXI
   M%RDETA = MESHES(I_MAIN_EVAC_MESH)%RDETA
   M%RDZETA= 1._EB/M%DZETA
   M%IBM1  = M%IBAR-1
   M%JBM1  = M%JBAR-1
   M%KBM1  = M%KBAR-1
   M%IBP1  = M%IBAR+1
   M%JBP1  = M%JBAR+1
   M%KBP1  = M%KBAR+1
   ! WRITE (LU_ERR,FMT='(A,I0,3A)') ' EVAC: Mesh number ', NM, ' name ', TRIM(ID), ' defined for evacuation'

END DO LOOP_EMESHES

N_END = N_EXITS - N_CO_EXITS + N_DOORS
LOOP_EXITS: DO N = 1, N_END
   I = EMESH_EXITS(N)%EMESH  ! The main evacuation mesh index (for EMESH_EXITS(I) array)
   IF (.NOT.EMESH_EXITS(N)%DEFINE_MESH) CYCLE LOOP_EXITS

   EMESH_EXITS(N)%MAINMESH = EMESH_NM(EMESH_EXITS(N)%EMESH)        ! The 1,...,NMESHES index
   ! Only main evacuation meshes in FDS6
   EMESH_EXITS(N)%IMESH = EMESH_EXITS(N)%MAINMESH   ! The mesh index (all meshes included)

   ! Set MESH defaults

   IJK(1)= EMESH_IJK(1,I)
   IJK(2)= EMESH_IJK(2,I)
   IJK(3)= EMESH_IJK(3,I)

   ALLOCATE(EMESH_EXITS(N)%U_EVAC(0:IJK(1)+1,0:IJK(2)+1),STAT=IZERO)
   CALL ChkMemErr('READ','EMESH_EXITS(N)%U_EVAC',IZERO)
   ALLOCATE(EMESH_EXITS(N)%V_EVAC(0:IJK(1)+1,0:IJK(2)+1),STAT=IZERO)
   CALL ChkMemErr('READ','EMESH_EXITS(N)%V_EVAC',IZERO)

   CYCLE LOOP_EXITS
ENDDO LOOP_EXITS

NN = 0
JMAX = 0
DO I = 1, NM
   EV_IF: IF (EVACUATION_SKIP(I) .AND. EVACUATION_ONLY(I)) THEN
      J = 0  ! Index of the flow field (for a main evacuation mesh)
      NN = NN + 1 ! Main evacuation mesh index
      ! NN = EMESH_INDEX(NM)
      EMESH_NFIELDS(NN) = 0  ! How many fields for this main evacuation mesh
      LOOP_EXITS_0: DO N = 1, N_END
         IF (.NOT.EMESH_EXITS(N)%DEFINE_MESH) CYCLE LOOP_EXITS_0
         IF (.NOT.EMESH_EXITS(N)%EMESH == NN) CYCLE LOOP_EXITS_0
         J = J + 1
         EMESH_EXITS(N)%I_DOORS_EMESH = J
         EMESH_NFIELDS(NN) = J
      END DO LOOP_EXITS_0
      IF (EMESH_NFIELDS(NN)==0) THEN
         WRITE(MESSAGE,'(A,I0,3A)') 'ERROR: EVAC: Emesh ',NN,' ',TRIM(EMESH_ID(NN)),' needs at least one DOOR/EXIT.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ELSE
         WRITE(LU_ERR,FMT='(A,I0,3A,I0,A)') ' EVAC: Emesh ',NN,' ',TRIM(EMESH_ID(NN)),' has ',&
            EMESH_NFIELDS(NN),' door flow fields'
      ENDIF
   ENDIF EV_IF
ENDDO

! Next line should be executed only once during a FDS+Evac run
JMAX = MAXVAL(EMESH_NFIELDS,1)
EVAC_TIME_ITERATIONS = EVAC_TIME_ITERATIONS*JMAX

LOOP_STAIRS: DO N = 1, N_STRS

   ! Evacuation meshes for the stairs.

   ! Set MESH defaults

   RGB   = EMESH_STAIRS(N)%RGB
   COLOR = 'null'
   ID = TRIM('Emesh_' // TRIM(EMESH_STAIRS(N)%ID))
   MPI_PROCESS = -1
   LEVEL = 0
   EVACUATION = .TRUE.
   EVAC_HUMANS = .TRUE.
   EVAC_Z_OFFSET = EMESH_STAIRS(N)%EVAC_Z_OFFSET

   ! Increase the MESH counter by 1

   NM = NM + 1
   EMESH_STAIRS(N)%IMESH = NM

   ! Fill in MESH related variables

   M => MESHES(NM)
   M%MESH_LEVEL = LEVEL
   M%IBAR = EMESH_STAIRS(N)%IBAR
   M%JBAR = EMESH_STAIRS(N)%JBAR
   M%KBAR = EMESH_STAIRS(N)%KBAR
   IBAR_MAX = MAX(IBAR_MAX,M%IBAR)
   JBAR_MAX = MAX(JBAR_MAX,M%JBAR)
   KBAR_MAX = MAX(KBAR_MAX,M%KBAR)
   EVACUATION_ONLY(NM) = .TRUE.
   EVACUATION_SKIP(NM) = .TRUE.
   EVACUATION_Z_OFFSET(NM) = EVAC_Z_OFFSET
   M%N_EXTERNAL_WALL_CELLS = 2*M%IBAR*M%KBAR+2*M%JBAR*M%KBAR
   IF (EVACUATION .AND. M%KBAR/=1) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: IJK(3) must be 1 for all evacuation grids'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Associate the MESH with the PROCESS

   IF (MYID==CURRENT_MPI_PROCESS) THEN
      LOWER_MESH_INDEX = MIN(LOWER_MESH_INDEX,NM)
      UPPER_MESH_INDEX = MAX(UPPER_MESH_INDEX,NM)
   ENDIF

   PROCESS(NM) = CURRENT_MPI_PROCESS
   IF (MYID==0 .AND. VERBOSE) WRITE(LU_ERR,'(A,I0,A,I0)') ' Mesh ',NM,' is assigned to MPI Process ',PROCESS(NM)
   IF (EVACUATION_ONLY(NM) .AND. (N_MPI_PROCESSES>1)) EVAC_PROCESS = N_MPI_PROCESSES-1

   ! Mesh boundary colors

   ALLOCATE(M%RGB(3))
   M%RGB = EMESH_STAIRS(N)%RGB

   ! Mesh Geometry and Name

   WRITE(MESH_NAME(NM),'(A,I7.7)') 'MESH_',NM
   IF (ID/='null') MESH_NAME(NM) = ID

   M%XS    = EMESH_STAIRS(N)%XB(1)
   M%XF    = EMESH_STAIRS(N)%XB(2)
   M%YS    = EMESH_STAIRS(N)%XB(3)
   M%YF    = EMESH_STAIRS(N)%XB(4)
   M%ZS    = EMESH_STAIRS(N)%XB(5)
   M%ZF    = EMESH_STAIRS(N)%XB(6)
   M%DXI   = (M%XF-M%XS)/REAL(M%IBAR,EB)
   M%DETA  = (M%YF-M%YS)/REAL(M%JBAR,EB)
   M%DZETA = (M%ZF-M%ZS)/REAL(M%KBAR,EB)
   M%RDXI  = 1._EB/M%DXI
   M%RDETA = 1._EB/M%DETA
   M%RDZETA= 1._EB/M%DZETA
   M%IBM1  = M%IBAR-1
   M%JBM1  = M%JBAR-1
   M%KBM1  = M%KBAR-1
   M%IBP1  = M%IBAR+1
   M%JBP1  = M%JBAR+1
   M%KBP1  = M%KBAR+1
   WRITE (LU_ERR,FMT='(A,I0,3A)') ' EVAC: Mesh number ', NM, ' name ', TRIM(ID), ' defined for evacuation'

ENDDO LOOP_STAIRS

IF (ALL(EVACUATION_ONLY)) THEN
   DO N = 1, NMESHES
      M => MESHES(NM)
      XS_MIN  = MIN(XS_MIN,M%XS)
      XF_MAX  = MAX(XF_MAX,M%XF)
      YS_MIN  = MIN(YS_MIN,M%YS)
      YF_MAX  = MAX(YF_MAX,M%YF)
      ZS_MIN  = MIN(ZS_MIN,M%ZS)
      ZF_MAX  = MAX(ZF_MAX,M%ZF)
   ENDDO
ENDIF

RETURN
END SUBROUTINE DEFINE_EVACUATION_MESHES

END SUBROUTINE READ_MESH


!> \brief Read the TRAN namelist lines and compute the polynomial transform function for the vertical coordinate

SUBROUTINE READ_TRAN

USE MATH_FUNCTIONS, ONLY : GAUSSJ
CHARACTER(LABEL_LENGTH) :: ID
REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: A,XX
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ND
REAL(EB) :: PC,CC,COEF,XI,ETA,ZETA
INTEGER  IEXP,IC,IDERIV,N,K,IOS,I,MESH_NUMBER,NIPX,NIPY,NIPZ,NIPXS,NIPYS,NIPZS,NIPXF,NIPYF,NIPZF,NM
LOGICAL :: PROCESS_TRANS
TYPE (MESH_TYPE), POINTER :: M=>NULL()
TYPE (TRAN_TYPE), POINTER :: T=>NULL()
NAMELIST /TRNX/ CC,FYI,ID,IDERIV,MESH_NUMBER,PC
NAMELIST /TRNY/ CC,FYI,ID,IDERIV,MESH_NUMBER,PC
NAMELIST /TRNZ/ CC,FYI,ID,IDERIV,MESH_NUMBER,PC

! Scan the input file, counting the number of NAMELIST entries

ALLOCATE(TRANS(NMESHES))

MESH_LOOP: DO NM=1,NMESHES

   M => MESHES(NM)

   ! Only read and process the TRNX, TRNY and TRNZ lines if the current MPI
   ! process (MYID) controls mesh NM or one of its neighbors.

   PROCESS_TRANS = .FALSE.
   DO N=1,M%N_NEIGHBORING_MESHES
      IF (MYID==PROCESS(M%NEIGHBORING_MESH(N))) PROCESS_TRANS = .TRUE.
   ENDDO

   ! A fast fix for fire+evacuation calculation with MPI and neighboring_mesh array problem
   ! Evacuation meshes need fire mesh obst information => evacuation process processes all fire meshes
   IF(MYID==EVAC_PROCESS .AND. .NOT.EVACUATION_ONLY(NM)) PROCESS_TRANS = .TRUE.

   IF (.NOT.PROCESS_TRANS) CYCLE MESH_LOOP

   T => TRANS(NM)

   DO N=1,3
      T%NOC(N) = 0
      TRNLOOP: DO
         IF (EVACUATION_ONLY(NM)) EXIT TRNLOOP
         ID = 'null'
         SELECT CASE (N)
            CASE(1)
               CALL CHECKREAD('TRNX',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
               IF (IOS==1) EXIT TRNLOOP
               MESH_NUMBER = 1
               READ(LU_INPUT,NML=TRNX,END=17,ERR=18,IOSTAT=IOS)
               IF (ID/='null') THEN
                  MESH_NUMBER = HUGE(1)
                  IF (TRIM(M%TRNX_ID)==TRIM(ID)) MESH_NUMBER=NM
               ENDIF
               IF (MESH_NUMBER>0 .AND. MESH_NUMBER/=NM) CYCLE TRNLOOP
            CASE(2)
               CALL CHECKREAD('TRNY',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
               IF (IOS==1) EXIT TRNLOOP
               MESH_NUMBER = 1
               READ(LU_INPUT,NML=TRNY,END=17,ERR=18,IOSTAT=IOS)
               IF (ID/='null') THEN
                  MESH_NUMBER = HUGE(1)
                  IF (TRIM(M%TRNY_ID)==TRIM(ID)) MESH_NUMBER=NM
               ENDIF
               IF (MESH_NUMBER>0 .AND. MESH_NUMBER/=NM) CYCLE TRNLOOP
            CASE(3)
               CALL CHECKREAD('TRNZ',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
               IF (IOS==1) EXIT TRNLOOP
               MESH_NUMBER = 1
               READ(LU_INPUT,NML=TRNZ,END=17,ERR=18,IOSTAT=IOS)
               IF (ID/='null') THEN
                  MESH_NUMBER = HUGE(1)
                  IF (TRIM(M%TRNZ_ID)==TRIM(ID)) MESH_NUMBER=NM
               ENDIF
               IF (MESH_NUMBER>0 .AND. MESH_NUMBER/=NM) CYCLE TRNLOOP
         END SELECT
         T%NOC(N) = T%NOC(N) + 1
         18 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with TRN* line') ; RETURN ; ENDIF
      ENDDO TRNLOOP
      17 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   ENDDO

   T%NOCMAX = MAX(T%NOC(1),T%NOC(2),T%NOC(3))
   ALLOCATE(A(T%NOCMAX+1,T%NOCMAX+1))
   ALLOCATE(XX(T%NOCMAX+1,3))
   ALLOCATE(ND(T%NOCMAX+1,3))
   ALLOCATE(T%C1(0:T%NOCMAX+1,3))
   T%C1               = 0._EB
   T%C1(1,1:3)        = 1._EB
   ALLOCATE(T%C2(0:T%NOCMAX+1,3))
   ALLOCATE(T%C3(0:T%NOCMAX+1,3))
   ALLOCATE(T%CCSTORE(T%NOCMAX,3))
   ALLOCATE(T%PCSTORE(T%NOCMAX,3))
   ALLOCATE(T%IDERIVSTORE(T%NOCMAX,3))

   T%ITRAN  = 0

   ICLOOP_1: DO IC=1,3
      NLOOP: DO N=1,T%NOC(IC)
         IDERIV = -1
         ID = 'null'
         IC_SELECT: SELECT CASE(IC)
            CASE(1)
               LOOP1: DO
                  CALL CHECKREAD('TRNX',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
                  IF (IOS==1) EXIT NLOOP
                  MESH_NUMBER = 1
                  READ(LU_INPUT,TRNX,END=1,ERR=2)
                  IF (ID/='null') THEN
                     MESH_NUMBER = HUGE(1)
                     IF (TRIM(M%TRNX_ID)==TRIM(ID)) MESH_NUMBER=NM
                  ENDIF
                  IF (MESH_NUMBER==0 .OR. MESH_NUMBER==NM) EXIT LOOP1
               ENDDO LOOP1
            CASE(2)
               LOOP2: DO
                  CALL CHECKREAD('TRNY',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
                  IF (IOS==1) EXIT NLOOP
                  MESH_NUMBER = 1
                  READ(LU_INPUT,TRNY,END=1,ERR=2)
                  IF (ID/='null') THEN
                     MESH_NUMBER = HUGE(1)
                     IF (TRIM(M%TRNY_ID)==TRIM(ID)) MESH_NUMBER=NM
                  ENDIF
                  IF (MESH_NUMBER==0 .OR. MESH_NUMBER==NM) EXIT LOOP2
               ENDDO LOOP2
            CASE(3)
               LOOP3: DO
                  CALL CHECKREAD('TRNZ',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
                  IF (IOS==1) EXIT NLOOP
                  MESH_NUMBER = 1
                  READ(LU_INPUT,TRNZ,END=1,ERR=2)
                  IF (ID/='null') THEN
                     MESH_NUMBER = HUGE(1)
                     IF (TRIM(M%TRNZ_ID)==TRIM(ID)) MESH_NUMBER=NM
                  ENDIF
                  IF (MESH_NUMBER==0 .OR. MESH_NUMBER==NM) EXIT LOOP3
               ENDDO LOOP3
         END SELECT IC_SELECT
         T%CCSTORE(N,IC) = CC
         T%PCSTORE(N,IC) = PC
         T%IDERIVSTORE(N,IC) = IDERIV
         IF (IDERIV>=0) T%ITRAN(IC) = 1
         IF (IDERIV<0)  T%ITRAN(IC) = 2
      2 CONTINUE
      ENDDO NLOOP
      1 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   ENDDO ICLOOP_1

   ICLOOP_2: DO IC=1,3

      SELECT CASE (T%ITRAN(IC))

         CASE (1)  ! polynomial transformation

            ND(1,IC)  = 0
            SELECT CASE(IC)
               CASE(1)
                  XX(1,IC)    = M%XF-M%XS
                  T%C1(1,IC)  = M%XF-M%XS
               CASE(2)
                  XX(1,IC)    = M%YF-M%YS
                  T%C1(1,IC)  = M%YF-M%YS
               CASE(3)
                  XX(1,IC)    = M%ZF-M%ZS
                  T%C1(1,IC)  = M%ZF-M%ZS
            END SELECT

            NNLOOP:  DO N=2,T%NOC(IC)+1
               IDERIV = T%IDERIVSTORE(N-1,IC)
               IF (IC==1) CC = T%CCSTORE(N-1,IC)-M%XS
               IF (IC==2) CC = T%CCSTORE(N-1,IC)-M%YS
               IF (IC==3) CC = T%CCSTORE(N-1,IC)-M%ZS
               IF (IC==1 .AND. IDERIV==0) PC = T%PCSTORE(N-1,IC)-M%XS
               IF (IC==2 .AND. IDERIV==0) PC = T%PCSTORE(N-1,IC)-M%YS
               IF (IC==3 .AND. IDERIV==0) PC = T%PCSTORE(N-1,IC)-M%ZS
               IF (IC==1 .AND. IDERIV>0) PC = T%PCSTORE(N-1,IC)
               IF (IC==2 .AND. IDERIV>0) PC = T%PCSTORE(N-1,IC)
               IF (IC==3 .AND. IDERIV>0) PC = T%PCSTORE(N-1,IC)
               ND(N,IC) = IDERIV
               XX(N,IC) = CC
               T%C1(N,IC) = PC
            ENDDO NNLOOP

            DO K=1,T%NOC(IC)+1
               DO N=1,T%NOC(IC)+1
                  COEF = IFAC(K,ND(N,IC))
                  IEXP = K-ND(N,IC)
                  IF (IEXP<0) A(N,K) = 0._EB
                  IF (IEXP==0) A(N,K) = COEF
                  IF (IEXP>0) A(N,K) = COEF*XX(N,IC)**IEXP
               ENDDO
            ENDDO

            IERROR = 0
            CALL GAUSSJ(A,T%NOC(IC)+1,T%NOCMAX+1,T%C1(1:T%NOCMAX+1,IC),1,1,IERROR)
            IF (IERROR/=0) THEN ; CALL SHUTDOWN('ERROR: Problem with grid transformation') ; RETURN ; ENDIF

         CASE (2)  ! linear transformation

            T%C1(0,IC) = 0._EB
            T%C2(0,IC) = 0._EB
            DO N=1,T%NOC(IC)
               IF (IC==1) CC = T%CCSTORE(N,IC)-M%XS
               IF (IC==2) CC = T%CCSTORE(N,IC)-M%YS
               IF (IC==3) CC = T%CCSTORE(N,IC)-M%ZS
               IF (IC==1) PC = T%PCSTORE(N,IC)-M%XS
               IF (IC==2) PC = T%PCSTORE(N,IC)-M%YS
               IF (IC==3) PC = T%PCSTORE(N,IC)-M%ZS
               T%C1(N,IC) = CC
               T%C2(N,IC) = PC
            ENDDO

            SELECT CASE(IC)
               CASE(1)
                  T%C1(T%NOC(1)+1,1) = M%XF-M%XS
                  T%C2(T%NOC(1)+1,1) = M%XF-M%XS
               CASE(2)
                  T%C1(T%NOC(2)+1,2) = M%YF-M%YS
                  T%C2(T%NOC(2)+1,2) = M%YF-M%YS
               CASE(3)
                  T%C1(T%NOC(3)+1,3) = M%ZF-M%ZS
                  T%C2(T%NOC(3)+1,3) = M%ZF-M%ZS
            END SELECT

            DO N=1,T%NOC(IC)+1
               IF (T%C1(N,IC)-T%C1(N-1,IC)<TWO_EPSILON_EB) THEN
                  CALL SHUTDOWN('ERROR: Do not specify endpoints in linear grid transformation')
                  RETURN
               ENDIF
               T%C3(N,IC) = (T%C2(N,IC)-T%C2(N-1,IC))/(T%C1(N,IC)-T%C1(N-1,IC))
            ENDDO
      END SELECT
   ENDDO ICLOOP_2

   DEALLOCATE(A)
   DEALLOCATE(XX)
   DEALLOCATE(ND)

   ! Set up grid stretching arrays

   ALLOCATE(M%R(0:M%IBAR),STAT=IZERO)
   CALL ChkMemErr('READ','R',IZERO)
   ALLOCATE(M%RC(0:M%IBAR+1),STAT=IZERO)
   CALL ChkMemErr('READ','RC',IZERO)
   M%RC = 1._EB
   ALLOCATE(M%RRN(0:M%IBP1),STAT=IZERO)
   CALL ChkMemErr('READ','RRN',IZERO)
   M%RRN = 1._EB
   ALLOCATE(M%X(0:M%IBAR),STAT=IZERO)
   CALL ChkMemErr('READ','X',IZERO)
   ALLOCATE(M%XC(0:M%IBP1),STAT=IZERO)
   CALL ChkMemErr('READ','XC',IZERO)
   ALLOCATE(M%HX(0:M%IBP1),STAT=IZERO)
   CALL ChkMemErr('READ','HX',IZERO)
   ALLOCATE(M%DX(0:M%IBP1),STAT=IZERO)
   CALL ChkMemErr('READ','DX',IZERO)
   ALLOCATE(M%RDX(0:M%IBP1),STAT=IZERO)
   CALL ChkMemErr('READ','RDX',IZERO)
   ALLOCATE(M%DXN(0:M%IBAR),STAT=IZERO)
   CALL ChkMemErr('READ','DXN',IZERO)
   ALLOCATE(M%RDXN(0:M%IBAR),STAT=IZERO)
   CALL ChkMemErr('READ','RDXN',IZERO)
   ALLOCATE(M%Y(0:M%JBAR),STAT=IZERO)
   CALL ChkMemErr('READ','Y',IZERO)
   ALLOCATE(M%YC(0:M%JBP1),STAT=IZERO)
   CALL ChkMemErr('READ','YC',IZERO)
   ALLOCATE(M%HY(0:M%JBP1),STAT=IZERO)
   CALL ChkMemErr('READ','HY',IZERO)
   ALLOCATE(M%DY(0:M%JBP1),STAT=IZERO)
   CALL ChkMemErr('READ','DY',IZERO)
   ALLOCATE(M%RDY(0:M%JBP1),STAT=IZERO)
   CALL ChkMemErr('READ','RDY',IZERO)
   ALLOCATE(M%DYN(0:M%JBAR),STAT=IZERO)
   CALL ChkMemErr('READ','DYN',IZERO)
   ALLOCATE(M%RDYN(0:M%JBAR),STAT=IZERO)
   CALL ChkMemErr('READ','RDYN',IZERO)
   ALLOCATE(M%Z(0:M%KBAR),STAT=IZERO)
   CALL ChkMemErr('READ','Z',IZERO)
   ALLOCATE(M%ZC(0:M%KBP1),STAT=IZERO)
   CALL ChkMemErr('READ','ZC',IZERO)
   ALLOCATE(M%HZ(0:M%KBP1),STAT=IZERO)
   CALL ChkMemErr('READ','HZ',IZERO)
   ALLOCATE(M%DZ(0:M%KBP1),STAT=IZERO)
   CALL ChkMemErr('READ','DZ',IZERO)
   ALLOCATE(M%RDZ(0:M%KBP1),STAT=IZERO)
   CALL ChkMemErr('READ','RDZ',IZERO)
   ALLOCATE(M%DZN(0:M%KBAR),STAT=IZERO)
   CALL ChkMemErr('READ','DZN',IZERO)
   ALLOCATE(M%RDZN(0:M%KBAR),STAT=IZERO)
   CALL ChkMemErr('READ','RDZN',IZERO)

   ! Define X grid stretching terms

   M%DXMIN = 1000000._EB

   DO I=0,M%IBAR
      XI     = I*M%DXI
      M%X(I) = M%XS + G(XI,1,NM)
      IF (CYLINDRICAL) THEN
         M%R(I) = M%X(I)
      ELSE
         M%R(I) = 1._EB
      ENDIF
      IF (I>0) THEN
         M%DX(I) = M%X(I) - M%X(I-1)
         M%HX(I) = M%DX(I)/M%DXI
         M%DXMIN = MIN(M%DXMIN,M%DX(I))
         IF (M%HX(I)<=0._EB) THEN
            WRITE(MESSAGE,'(A,I0)')  'ERROR: x transformation not monotonic, mesh ',NM
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         M%RDX(I) = 1._EB/M%DX(I)
      ENDIF
   ENDDO
   M%X(0)       = M%XS
   M%X(M%IBAR)  = M%XF
   M%HX(0)      = M%HX(1)
   M%HX(M%IBP1) = M%HX(M%IBAR)
   IF (T%NOC(1)==0) M%HX = 1._EB
   M%DX(0)      = M%DX(1)
   M%DX(M%IBP1) = M%DX(M%IBAR)
   M%RDX(0)     = 1._EB/M%DX(1)
   M%RDX(M%IBP1)= 1._EB/M%DX(M%IBAR)

   DO I=0,M%IBAR
      M%DXN(I)  = 0.5_EB*(M%DX(I)+M%DX(I+1))
      M%RDXN(I) = 1._EB/M%DXN(I)
      IF (I>0) M%XC(I) = 0.5_EB*(M%X(I)+M%X(I-1))
   ENDDO
   M%XC(0)      = M%XS - 0.5_EB*M%DX(0)
   M%XC(M%IBP1) = M%XF + 0.5_EB*M%DX(M%IBP1)

   IF (CYLINDRICAL) THEN
      DO I=1,M%IBAR
         M%RRN(I) = 2._EB/(M%R(I)+M%R(I-1))
         M%RC(I)  = 0.5_EB*(M%R(I)+M%R(I-1))
      ENDDO
      M%RRN(0)    = M%RRN(1)
      M%RRN(M%IBP1) = M%RRN(M%IBAR)
   ENDIF

   ! Define Y grid stretching terms

   M%DYMIN = 1000000._EB

   DO J=0,M%JBAR
      ETA    = J*M%DETA
      M%Y(J) = M%YS + G(ETA,2,NM)
      IF (J>0) THEN
         M%DY(J) = M%Y(J) - M%Y(J-1)
         M%HY(J) = M%DY(J)/M%DETA
         M%DYMIN = MIN(M%DYMIN,M%DY(J))
         IF (M%HY(J)<=0._EB) THEN
            WRITE(MESSAGE,'(A,I0)')  'ERROR: y transformation not monotonic, mesh ',NM
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         M%RDY(J) = 1._EB/M%DY(J)
      ENDIF
   ENDDO
   M%Y(0)       = M%YS
   M%Y(M%JBAR)  = M%YF
   M%HY(0)      = M%HY(1)
   M%HY(M%JBP1) = M%HY(M%JBAR)
   IF (T%NOC(2)==0) M%HY = 1._EB
   M%DY(0)      = M%DY(1)
   M%DY(M%JBP1) = M%DY(M%JBAR)
   M%RDY(0)     = 1._EB/M%DY(1)
   M%RDY(M%JBP1)= 1._EB/M%DY(M%JBAR)

   DO J=0,M%JBAR
      M%DYN(J)  = 0.5_EB*(M%DY(J)+M%DY(J+1))
      M%RDYN(J) = 1._EB/M%DYN(J)
      IF (J>0) M%YC(J) = 0.5_EB*(M%Y(J)+M%Y(J-1))
   ENDDO
   M%YC(0)      = M%YS - 0.5_EB*M%DY(0)
   M%YC(M%JBP1) = M%YF + 0.5_EB*M%DY(M%JBP1)

   ! Define Z grid stretching terms

   M%DZMIN = 1000000._EB

   DO K=0,M%KBAR
      ZETA   = K*M%DZETA
      M%Z(K) = M%ZS + G(ZETA,3,NM)
      IF (K>0) THEN
         M%DZ(K) = M%Z(K) - M%Z(K-1)
         M%HZ(K) = M%DZ(K)/M%DZETA
         M%DZMIN = MIN(M%DZMIN,M%DZ(K))
         IF (M%HZ(K)<=0._EB) THEN
            WRITE(MESSAGE,'(A,I0)') 'ERROR: z transformation not monotonic, mesh ',NM
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         M%RDZ(K) = 1._EB/M%DZ(K)
      ENDIF
   ENDDO
   M%Z(0)       = M%ZS
   M%Z(M%KBAR)  = M%ZF
   M%HZ(0)      = M%HZ(1)
   M%HZ(M%KBP1) = M%HZ(M%KBAR)
   IF (T%NOC(3)==0) M%HZ = 1._EB
   M%DZ(0)      = M%DZ(1)
   M%DZ(M%KBP1) = M%DZ(M%KBAR)
   M%RDZ(0)     = 1._EB/M%DZ(1)
   M%RDZ(M%KBP1)= 1._EB/M%DZ(M%KBAR)

   DO K=0,M%KBAR
      M%DZN(K)  = 0.5_EB*(M%DZ(K)+M%DZ(K+1))
      M%RDZN(K) = 1._EB/M%DZN(K)
      IF (K>0) M%ZC(K) = 0.5_EB*(M%Z(K)+M%Z(K-1))
   ENDDO
   M%ZC(0)      = M%ZS - 0.5_EB*M%DZ(0)
   M%ZC(M%KBP1) = M%ZF + 0.5_EB*M%DZ(M%KBP1)
   DZS_MAX = MAX(DZS_MAX,M%DZ(0))
   DZF_MAX = MAX(DZF_MAX,M%DZ(M%KBP1))

   ! Set default value for USE_ATMOSPHERIC_INTERPOLATION, may be overwritten by user on WIND line

   IF (STRATIFICATION .AND. ANY(M%DZ>1.999_EB)) USE_ATMOSPHERIC_INTERPOLATION=.TRUE.

   ! Set up arrays that will return coordinate positions

   NIPX   = 500*M%IBAR
   NIPY   = 500*M%JBAR
   NIPZ   = 500*M%KBAR
   NIPXS  = NINT(NIPX*M%DX(0)/(M%XF-M%XS))
   NIPXF  = NINT(NIPX*M%DX(M%IBP1)/(M%XF-M%XS))
   NIPYS  = NINT(NIPY*M%DY(0)/(M%YF-M%YS))
   NIPYF  = NINT(NIPY*M%DY(M%JBP1)/(M%YF-M%YS))
   NIPZS  = NINT(NIPZ*M%DZ(0)/(M%ZF-M%ZS))
   NIPZF  = NINT(NIPZ*M%DZ(M%KBP1)/(M%ZF-M%ZS))
   M%RDXINT = REAL(NIPX,EB)/(M%XF-M%XS)
   M%RDYINT = REAL(NIPY,EB)/(M%YF-M%YS)
   M%RDZINT = REAL(NIPZ,EB)/(M%ZF-M%ZS)

   ALLOCATE(M%CELLSI(-NIPXS:NIPX+NIPXF),STAT=IZERO)
   CALL ChkMemErr('READ','CELLSI',IZERO)
   ALLOCATE(M%CELLSJ(-NIPYS:NIPY+NIPYF),STAT=IZERO)
   CALL ChkMemErr('READ','CELLSJ',IZERO)
   ALLOCATE(M%CELLSK(-NIPZS:NIPZ+NIPZF),STAT=IZERO)
   CALL ChkMemErr('READ','CELLSK',IZERO)

   M%CELLSI_LO=-NIPXS
   M%CELLSI_HI=NIPX+NIPXF
   DO I=M%CELLSI_LO,M%CELLSI_HI
      M%CELLSI(I) = GINV(REAL(I,EB)/M%RDXINT,1,NM)*M%RDXI
      M%CELLSI(I) = MAX(M%CELLSI(I),-0.9_EB)
      M%CELLSI(I) = MIN(M%CELLSI(I),REAL(M%IBAR)+0.9_EB)
   ENDDO

   M%CELLSJ_LO=-NIPYS
   M%CELLSJ_HI=NIPY+NIPYF
   DO J=M%CELLSJ_LO,M%CELLSJ_HI
      M%CELLSJ(J) = GINV(REAL(J,EB)/M%RDYINT,2,NM)*M%RDETA
      M%CELLSJ(J) = MAX(M%CELLSJ(J),-0.9_EB)
      M%CELLSJ(J) = MIN(M%CELLSJ(J),REAL(M%JBAR)+0.9_EB)
   ENDDO

   M%CELLSK_LO=-NIPZS
   M%CELLSK_HI=NIPZ+NIPZF
   DO K=M%CELLSK_LO,M%CELLSK_HI
      M%CELLSK(K) = GINV(REAL(K,EB)/M%RDZINT,3,NM)*M%RDZETA
      M%CELLSK(K) = MAX(M%CELLSK(K),-0.9_EB)
      M%CELLSK(K) = MIN(M%CELLSK(K),REAL(M%KBAR)+0.9_EB)
   ENDDO

ENDDO MESH_LOOP


CONTAINS

INTEGER FUNCTION IFAC(II,NN)
INTEGER, INTENT(IN) :: II,NN
INTEGER :: III
IFAC = 1
DO III=II-NN+1,II
   IFAC = IFAC*III
ENDDO
END FUNCTION IFAC

END SUBROUTINE READ_TRAN


!> \brief Read the TIME namelist line
!> \param DT Time step (s)

SUBROUTINE READ_TIME(DT)

REAL(EB), INTENT(OUT) :: DT
NAMELIST /TIME/ DT,DT_END_FILL,DT_END_MINIMUM,EVAC_DT_FLOWFIELD,EVAC_DT_STEADY_STATE,FYI,LIMITING_DT_RATIO,LOCK_TIME_STEP,&
                RESTRICT_TIME_STEP,T_BEGIN,T_END,T_END_GEOM,TIME_SHRINK_FACTOR,WALL_INCREMENT,WALL_INCREMENT_HT3D

DT                   = -1._EB
EVAC_DT_FLOWFIELD    = 0.01_EB
EVAC_DT_STEADY_STATE = 0.05_EB
TIME_SHRINK_FACTOR   = 1._EB
T_BEGIN              = 0._EB
T_END                = 1._EB
T_END_GEOM           = T_END
IF (ALL(EVACUATION_ONLY)) DT = EVAC_DT_STEADY_STATE

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
READ_TIME_LOOP: DO
   CALL CHECKREAD('TIME',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_TIME_LOOP
   READ(LU_INPUT,TIME,END=21,ERR=22,IOSTAT=IOS)
   22 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with TIME line') ; RETURN ; ENDIF
ENDDO READ_TIME_LOOP
21 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (T_END<=T_BEGIN) SETUP_ONLY = .TRUE.
T_END = T_BEGIN + (T_END-T_BEGIN)/TIME_SHRINK_FACTOR

! No need for CHECK_MESH_ALIGNMENT if not SETUP_ONLY

IF (T_END>TWO_EPSILON_EB) CHECK_MESH_ALIGNMENT=.FALSE. ! overwrite user-specified value

END SUBROUTINE READ_TIME


!> \brief Read the MOVE namelist line

SUBROUTINE READ_MOVE

REAL(EB) :: SCALE,SCALEX,SCALEY,SCALEZ,DX,DY,DZ,X0,Y0,Z0,AXIS(3),ROTATION_ANGLE,T34(12)
INTEGER :: N
CHARACTER(LABEL_LENGTH) :: ID
TYPE(MOVEMENT_TYPE), POINTER :: MV
NAMELIST /MOVE/ AXIS,SCALE,SCALEX,SCALEY,SCALEZ,DX,DY,DZ,FYI,ID,ROTATION_ANGLE,X0,Y0,Z0,T34

N_MOVE = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_MOVE_LOOP: DO
   CALL CHECKREAD('MOVE',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_MOVE_LOOP
   READ(LU_INPUT,NML=MOVE,END=9,ERR=10,IOSTAT=IOS)
   N_MOVE = N_MOVE + 1
   10 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with MOVE number ',N_MOVE,', line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
ENDDO COUNT_MOVE_LOOP
9 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

ALLOCATE(MOVEMENT(N_MOVE),STAT=IZERO)
CALL ChkMemErr('READ','MOVEMENT',IZERO)

READ_MOVE_LOOP: DO N=1,N_MOVE

   ROTATION_ANGLE   = 0._EB
   AXIS    = (/0._EB,0._EB,1._EB/)
   ID      = 'null'
   SCALE   = 1._EB
   SCALEX  = 1._EB
   SCALEY  = 1._EB
   SCALEZ  = 1._EB
   DX      = 0._EB
   DY      = 0._EB
   DZ      = 0._EB
   X0      = 0._EB
   Y0      = 0._EB
   Z0      = 0._EB
   T34     = 0._EB

   CALL CHECKREAD('MOVE',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_MOVE_LOOP
   READ(LU_INPUT,MOVE)

   MV => MOVEMENT(N)
   MV%AXIS  = AXIS/SQRT(DOT_PRODUCT(AXIS,AXIS))
   MV%INDEX = N
   MV%ID = ID
   MV%X0 = X0
   MV%Y0 = Y0
   MV%Z0 = Z0
   MV%SCALE  = SCALE
   MV%SCALEX = SCALEX
   MV%SCALEY = SCALEY
   MV%SCALEZ = SCALEZ
   MV%DX = DX
   MV%DY = DY
   MV%DZ = DZ
   MV%ROTATION_ANGLE = -ROTATION_ANGLE
   MV%T34(1:3,1:4)   = RESHAPE(T34, (/3, 4/) )

ENDDO READ_MOVE_LOOP

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

END SUBROUTINE READ_MOVE


!> \brief Read the MULT namelist line(s)

SUBROUTINE READ_MULT

REAL(EB) :: DX,DY,DZ,DXB(6),DX0,DY0,DZ0
CHARACTER(LABEL_LENGTH) :: ID
INTEGER :: N,I1,I2,J1,J2,K1,K2,I_LOWER,I_UPPER,J_LOWER,J_UPPER,K_LOWER,K_UPPER,N_LOWER,N_UPPER,&
           I_LOWER_SKIP,I_UPPER_SKIP,J_LOWER_SKIP,J_UPPER_SKIP,K_LOWER_SKIP,K_UPPER_SKIP,N_LOWER_SKIP,N_UPPER_SKIP
TYPE(MULTIPLIER_TYPE), POINTER :: MR=>NULL()
NAMELIST /MULT/ DX,DXB,DX0,DY,DY0,DZ,DZ0,FYI,ID,&
                I_LOWER,I_LOWER_SKIP,I_UPPER,I_UPPER_SKIP,&
                J_LOWER,J_LOWER_SKIP,J_UPPER,J_UPPER_SKIP,&
                K_LOWER,K_LOWER_SKIP,K_UPPER,K_UPPER_SKIP,&
                N_LOWER,N_LOWER_SKIP,N_UPPER_SKIP,N_UPPER

N_MULT = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_MULT_LOOP: DO
   CALL CHECKREAD('MULT',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_MULT_LOOP
   READ(LU_INPUT,NML=MULT,END=9,ERR=10,IOSTAT=IOS)
   N_MULT = N_MULT + 1
   10 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with MULT number ',N_MULT,', line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
ENDDO COUNT_MULT_LOOP
9 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

ALLOCATE(MULTIPLIER(0:N_MULT),STAT=IZERO)
CALL ChkMemErr('READ','MULTIPLIER',IZERO)

READ_MULT_LOOP: DO N=0,N_MULT

   ID      = 'null'
   IF (N==0) ID = 'MULT DEFAULT'
   DX      = 0._EB
   DY      = 0._EB
   DZ      = 0._EB
   DX0     = 0._EB
   DY0     = 0._EB
   DZ0     = 0._EB
   DXB     = 0._EB
   I_LOWER = 0
   I_UPPER = 0
   J_LOWER = 0
   J_UPPER = 0
   K_LOWER = 0
   K_UPPER = 0
   N_LOWER = 0
   N_UPPER = 0
   I_LOWER_SKIP = -999
   I_UPPER_SKIP = 999
   J_LOWER_SKIP = -999
   J_UPPER_SKIP = 999
   K_LOWER_SKIP = -999
   K_UPPER_SKIP = 999
   N_LOWER_SKIP = -999
   N_UPPER_SKIP = 999

   IF (N>0) THEN
      CALL CHECKREAD('MULT',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT READ_MULT_LOOP
      READ(LU_INPUT,MULT)
   ENDIF

   MR => MULTIPLIER(N)
   MR%ID      = ID
   MR%DXB     = DXB
   MR%DX0     = DX0
   MR%DY0     = DY0
   MR%DZ0     = DZ0
   IF (ABS(DX)>TWO_EPSILON_EB) MR%DXB(1:2) = DX
   IF (ABS(DY)>TWO_EPSILON_EB) MR%DXB(3:4) = DY
   IF (ABS(DZ)>TWO_EPSILON_EB) MR%DXB(5:6) = DZ

   MR%I_LOWER = I_LOWER
   MR%I_UPPER = I_UPPER
   MR%J_LOWER = J_LOWER
   MR%J_UPPER = J_UPPER
   MR%K_LOWER = K_LOWER
   MR%K_UPPER = K_UPPER
   MR%N_COPIES = (I_UPPER-I_LOWER+1)*(J_UPPER-J_LOWER+1)*(K_UPPER-K_LOWER+1)

   IF (N_LOWER/=0 .OR. N_UPPER/=0) THEN
      MR%SEQUENTIAL = .TRUE.
      MR%I_LOWER  = N_LOWER
      MR%I_UPPER  = N_UPPER
      MR%J_LOWER  = 0
      MR%J_UPPER  = 0
      MR%K_LOWER  = 0
      MR%K_UPPER  = 0
      MR%N_COPIES = (N_UPPER-N_LOWER+1)
      I_LOWER_SKIP = N_LOWER_SKIP
      I_UPPER_SKIP = N_UPPER_SKIP
   ENDIF

   ALLOCATE(MR%SKIP(MR%I_LOWER:MR%I_UPPER,MR%J_LOWER:MR%J_UPPER,MR%K_LOWER:MR%K_UPPER),STAT=IZERO)
   CALL ChkMemErr('READ_MULT','SKIP',IZERO)
   MR%SKIP = .FALSE.
   IF (I_LOWER_SKIP>=MR%I_LOWER .OR. J_LOWER_SKIP>=MR%J_LOWER .OR. K_LOWER_SKIP>=MR%K_LOWER .OR. &
       I_UPPER_SKIP<=MR%I_UPPER .OR. J_UPPER_SKIP<=MR%J_UPPER .OR. K_UPPER_SKIP<=MR%K_UPPER) THEN
      I1 = MAX(MR%I_LOWER,I_LOWER_SKIP)
      I2 = MIN(MR%I_UPPER,I_UPPER_SKIP)
      J1 = MAX(MR%J_LOWER,J_LOWER_SKIP)
      J2 = MIN(MR%J_UPPER,J_UPPER_SKIP)
      K1 = MAX(MR%K_LOWER,K_LOWER_SKIP)
      K2 = MIN(MR%K_UPPER,K_UPPER_SKIP)
      MR%SKIP(I1:I2,J1:J2,K1:K2) = .TRUE.
      MR%N_COPIES = MR%N_COPIES - (I2-I1+1)*(J2-J1+1)*(K2-K1+1)
   ENDIF

ENDDO READ_MULT_LOOP
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

END SUBROUTINE READ_MULT


!> \brief Read the MISC namelist line

SUBROUTINE READ_MISC

USE MATH_FUNCTIONS, ONLY: GET_RAMP_INDEX
REAL(EB) :: MAXIMUM_VISIBILITY
LOGICAL :: DNS,RESEARCH_MODE
CHARACTER(LABEL_LENGTH) :: ASSUMED_GAS_TEMPERATURE_RAMP,RAMP_GX,RAMP_GY,RAMP_GZ,TURBULENCE_MODEL,&
                           NEAR_WALL_TURBULENCE_MODEL,SIMULATION_MODE,FLUX_LIMITER

NAMELIST /MISC/ AEROSOL_AL2O3,AEROSOL_SCRUBBING,AGGLOMERATION,ALIGNMENT_TOLERANCE,ALLOW_SURFACE_PARTICLES, &
                ALLOW_UNDERSIDE_PARTICLES,ASSUMED_GAS_TEMPERATURE,ASSUMED_GAS_TEMPERATURE_RAMP,&
                BNDF_DEFAULT,CC_IBM,CC_SLIPIBM_VELO,CCVOL_LINK,CC_ZEROIBM_VELO,C_DEARDORFF,&
                CFL_MAX,CFL_MIN,CFL_VELOCITY_NORM,CHECK_HT,CHECK_MASS_CONSERVE,CHECK_VN, &
                CNF_CUTOFF,COMPUTE_CUTCELLS_ONLY,CONSTANT_SPECIFIC_HEAT_RATIO,&
                C_RNG,C_RNG_CUTOFF,C_SMAGORINSKY,C_VREMAN,&
                C_WALE,DO_IMPLICIT_CCREGION,DEPOSITION,ENTHALPY_TRANSPORT,&
                EVACUATION_DRILL,EVACUATION_MC_MODE,EVAC_PRESSURE_ITERATIONS,EVAC_SURF_DEFAULT,EVAC_TIME_ITERATIONS,&
                EVAP_MODEL,EXTERNAL_BOUNDARY_CORRECTION,&
                FLUX_LIMITER,FREEZE_VELOCITY,FYI,GAMMA,GRAVITATIONAL_DEPOSITION,&
                GRAVITATIONAL_SETTLING,GVEC,H_F_REFERENCE_TEMPERATURE,HT3D_TEST,&
                HUMIDITY,HVAC_LOCAL_PRESSURE,HVAC_MASS_TRANSPORT,HVAC_PRES_RELAX,IBLANK_SMV,LEVEL_SET_ELLIPSE,LEVEL_SET_MODE,&
                MAXIMUM_GEOMETRY_FACES,MAXIMUM_GEOMETRY_ZVALS,MAXIMUM_VISIBILITY,MAX_LEAK_PATHS,MINIMUM_FILM_THICKNESS,&
                MPI_TIMEOUT,NEAR_WALL_TURBULENCE_MODEL,NORTH_BEARING,&
                NOISE,NOISE_VELOCITY,NO_EVACUATION,NUCLEATION_SITES,ORIGIN_LAT,ORIGIN_LON,&
                OVERWRITE,PARTICLE_CFL,PARTICLE_CFL_MAX,PARTICLE_CFL_MIN,PERIODIC_TEST,POSITIVE_ERROR_TEST,&
                POROUS_FLOOR,PR,PROFILING,&
                PROJECTION,P_INF,QFAN_BETA_TEST,RAMP_GX,RAMP_GY,RAMP_GZ,RESTART,RESTART_CHID,&
                SC,SHARED_FILE_SYSTEM,SIMULATION_MODE,SMOKE_ALBEDO,SOLID_PHASE_ONLY,SOOT_OXIDATION,&
                STORE_DIVERGENCE_CORRECTION,TAU_DEFAULT,TENSOR_DIFFUSIVITY,TERRAIN_CASE,TERRAIN_IMAGE,TEXTURE_ORIGIN,&
                THERMOPHORETIC_DEPOSITION,THERMOPHORETIC_SETTLING,THICKEN_OBSTRUCTIONS,&
                TMPA,TURBULENCE_MODEL,TURBULENT_DEPOSITION,TURB_INIT_CLOCK,UVW_FILE,&
                VERBOSE,VISIBILITY_FACTOR,VN_MAX,VN_MIN,Y_CO2_INFTY,Y_O2_INFTY,&
                BAROCLINIC,DNS,RADIATION,RESEARCH_MODE,STRATIFICATION,SUPPRESSION,SURF_DEFAULT ! Backward compatibility

! Physical constants

TMPA         = 20._EB                                              ! Ambient temperature (C)

! Empirical heat transfer constants

PR_ONTH      = PR_AIR**ONTH
ASSUMED_GAS_TEMPERATURE = -1000.   ! Assumed gas temperature, used for diagnostics

! Miscellaneous constants

RESTART_CHID   = CHID
DNS            = .FALSE.
RESEARCH_MODE  = .FALSE.
IBLANK_SMV     = .TRUE.
SIMULATION_MODE = 'VLES'

TEXTURE_ORIGIN(1) = 0._EB
TEXTURE_ORIGIN(2) = 0._EB
TEXTURE_ORIGIN(3) = 0._EB

! EVACuation parameters

EVAC_PRESSURE_ITERATIONS = 50
EVAC_TIME_ITERATIONS     = 50
EVACUATION_MC_MODE       = .FALSE.
NO_EVACUATION            = .FALSE.
EVACUATION_DRILL         = .FALSE.

! LES parameters

PR                   = -1.0_EB  ! Turbulent Prandtl number
SC                   = -1.0_EB  ! Turbulent Schmidt number

! Misc

ASSUMED_GAS_TEMPERATURE_RAMP = 'null'
RAMP_GX              = 'null'
RAMP_GY              = 'null'
RAMP_GZ              = 'null'
GVEC(1)              = 0._EB        ! x-component of gravity
GVEC(2)              = 0._EB        ! y-component of gravity
GVEC(3)              = -GRAV        ! z-component of gravity
THICKEN_OBSTRUCTIONS = .FALSE.
N_TERRAIN_IMAGES     = 0
DO I = 1, MAX_TERRAIN_IMAGES
   TERRAIN_IMAGE(I) = 'null'
END DO
MAXIMUM_VISIBILITY   = 30._EB ! m
TURBULENCE_MODEL     = 'null'
NEAR_WALL_TURBULENCE_MODEL = 'null'
MAX_LEAK_PATHS       = 200
FLUX_LIMITER         = 'null'

! Initial read of the MISC line

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
MISC_LOOP: DO
   CALL CHECKREAD('MISC',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT MISC_LOOP
   READ(LU_INPUT,MISC,END=23,ERR=24,IOSTAT=IOS)
   24 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with MISC line') ; RETURN ; ENDIF
   N_TERRAIN_IMAGES = 0
   DO I = 1, MAX_TERRAIN_IMAGES
      IF( TERRAIN_IMAGE(I) /= 'null' ) N_TERRAIN_IMAGES = N_TERRAIN_IMAGES + 1
   END DO
ENDDO MISC_LOOP
23 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (RETURN_BEFORE_SIM_MODE) RETURN

! Choose simulation mode

IF (DNS .OR. SIMULATION_MODE=='DNS') THEN
   SIM_MODE = DNS_MODE
   CFL_VELOCITY_NORM = 1
   CFL_MAX = 0.5
   CFL_MIN = 0.4
   VN_MAX = 0.5
   VN_MIN = 0.4
   I_FLUX_LIMITER = CHARM_LIMITER
   PROJECTION = .TRUE.
   IF (TURBULENCE_MODEL/='null') THEN
      WRITE(MESSAGE,'(A,A,A)')  'ERROR: TURBULENCE_MODEL,',TRIM(TURBULENCE_MODEL),', is not appropriate for DNS.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ELSEIF (RESEARCH_MODE .OR. SIMULATION_MODE=='LES') THEN
   SIM_MODE = LES_MODE
   CFL_VELOCITY_NORM = 1
   I_FLUX_LIMITER = CHARM_LIMITER
   PROJECTION = .TRUE.
   TURBULENCE_MODEL = 'DEARDORFF'
   NEAR_WALL_TURBULENCE_MODEL = 'WALE'
ELSEIF (SIMULATION_MODE=='VLES') THEN
   SIM_MODE = VLES_MODE
   !! CFL_VELOCITY_NORM = 0 ! global default
   I_FLUX_LIMITER = SUPERBEE_LIMITER
   TURBULENCE_MODEL = 'DEARDORFF'
ELSEIF (SIMULATION_MODE=='SVLES') THEN
   SIM_MODE = SVLES_MODE
   I_FLUX_LIMITER = SUPERBEE_LIMITER
   TURBULENCE_MODEL = 'DEARDORFF'
   CFL_VELOCITY_NORM = 3
   CONSTANT_SPECIFIC_HEAT_RATIO = .TRUE.
   MAX_PRESSURE_ITERATIONS = 3 ! see PRES
ELSE
   WRITE(MESSAGE,'(A,A,A)')  'ERROR: SIMULATION_MODE, ',TRIM(SIMULATION_MODE),', is not an option.'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

! Re-read the line to pick up any user-specified options

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CALL CHECKREAD('MISC',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
IF (IOS==0) READ(LU_INPUT,MISC)
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! Temperature conversions

TMPA  = TMPA + TMPM
TMPA4 = TMPA**4

! Establish starting values for min/max temperature and density

TMPMIN = MAX(1._EB , MIN(TMPA,TMPM)-10._EB)
TMPMAX = 3000._EB
RHOMAX = 0._EB

! Miscellaneous

ASSUMED_GAS_TEMPERATURE = ASSUMED_GAS_TEMPERATURE + TMPM
TEX_ORI = TEXTURE_ORIGIN
GRAV = SQRT(DOT_PRODUCT(GVEC,GVEC))

! Velocity, force, and gravity ramps

I_RAMP_AGT  = 0
I_RAMP_GX   = 0
I_RAMP_GY   = 0
I_RAMP_GZ   = 0
N_RAMP      = 0
ALLOCATE(RAMP_ID(100))
ALLOCATE(RAMP_TYPE(100))
IF (ASSUMED_GAS_TEMPERATURE_RAMP/='null') CALL GET_RAMP_INDEX(ASSUMED_GAS_TEMPERATURE_RAMP,'TIME',I_RAMP_AGT)
IF (RAMP_GX/='null') CALL GET_RAMP_INDEX(RAMP_GX,'TIME',I_RAMP_GX)
IF (RAMP_GY/='null') CALL GET_RAMP_INDEX(RAMP_GY,'TIME',I_RAMP_GY)
IF (RAMP_GZ/='null') CALL GET_RAMP_INDEX(RAMP_GZ,'TIME',I_RAMP_GZ)

! Prandtl and Schmidt numbers

IF (SIM_MODE==DNS_MODE) THEN
   IF (PR<0._EB) PR = 0.7_EB
   IF (SC<0._EB) SC = 1.0_EB
ELSE
   IF (PR<0._EB) PR = 0.5_EB
   IF (SC<0._EB) SC = 0.5_EB
ENDIF

RSC = 1._EB/SC
RPR = 1._EB/PR

! Check for a restart file

IF (RESTART .AND. RESTART_CHID == CHID) APPEND = .TRUE.
IF (RESTART) NOISE  = .FALSE.

! Min and Max values of flux limiter

IF (I_FLUX_LIMITER<0 .OR. I_FLUX_LIMITER>5) THEN
   WRITE(MESSAGE,'(A)')  'ERROR on MISC: Permissible values for I_FLUX_LIMITER=0:5'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

! Level Set parameters

SELECT CASE(LEVEL_SET_MODE)
   CASE(1)
      LEVEL_SET_COUPLED_WIND = .FALSE.
      LEVEL_SET_COUPLED_FIRE = .FALSE.
      RADIATION              = .FALSE.
      FREEZE_VELOCITY        = .TRUE.
      SOLID_PHASE_ONLY       = .TRUE.
      TERRAIN_CASE           = .TRUE.
   CASE(2)
      LEVEL_SET_COUPLED_WIND = .TRUE.
      LEVEL_SET_COUPLED_FIRE = .FALSE.
      RADIATION              = .FALSE.
      FREEZE_VELOCITY        = .FALSE.
      SOLID_PHASE_ONLY       = .FALSE.
      TERRAIN_CASE           = .TRUE.
   CASE(3)
      LEVEL_SET_COUPLED_WIND = .TRUE.
      LEVEL_SET_COUPLED_FIRE = .FALSE.
      RADIATION              = .FALSE.
      FREEZE_VELOCITY        = .FALSE.
      SOLID_PHASE_ONLY       = .FALSE.
      TERRAIN_CASE           = .TRUE.
   CASE(4)
      LEVEL_SET_COUPLED_WIND = .TRUE.
      LEVEL_SET_COUPLED_FIRE = .TRUE.
      RADIATION              = .TRUE.
      FREEZE_VELOCITY        = .FALSE.
      SOLID_PHASE_ONLY       = .FALSE.
      TERRAIN_CASE           = .TRUE.
   CASE(5)
      LEVEL_SET_COUPLED_WIND = .TRUE.
      LEVEL_SET_COUPLED_FIRE = .TRUE.
      RADIATION              = .TRUE.
      FREEZE_VELOCITY        = .FALSE.
      SOLID_PHASE_ONLY       = .FALSE.
      TERRAIN_CASE           = .TRUE.
END SELECT

! Turbulence model

SELECT CASE (TRIM(TURBULENCE_MODEL))
   CASE ('CONSTANT SMAGORINSKY')
      TURB_MODEL=CONSMAG
   CASE ('DYNAMIC SMAGORINSKY')
      TURB_MODEL=DYNSMAG
   CASE ('DEARDORFF')
      TURB_MODEL=DEARDORFF
   CASE ('VREMAN')
      TURB_MODEL=VREMAN
   CASE ('RNG')
      TURB_MODEL=RNG
   CASE ('WALE')
      TURB_MODEL=WALE
   CASE ('null')
      TURB_MODEL=NO_TURB_MODEL
   CASE DEFAULT
      WRITE(MESSAGE,'(A,A,A)')  'ERROR: TURBULENCE_MODEL, ',TRIM(TURBULENCE_MODEL),', is not recognized.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
END SELECT

! Near wall eddy viscosity model

SELECT CASE (TRIM(NEAR_WALL_TURBULENCE_MODEL))
   CASE DEFAULT
      NEAR_WALL_TURB_MODEL=CONSMAG
   CASE ('WALE')
      NEAR_WALL_TURB_MODEL=WALE
END SELECT

! Flux limiter

SELECT CASE (TRIM(FLUX_LIMITER))
   CASE ('null')
      ! set above, see SIMULATION_MODE
   CASE ('CENTRAL')
      I_FLUX_LIMITER=CENTRAL_LIMITER
   CASE ('GODUNOV')
      I_FLUX_LIMITER=GODUNOV_LIMITER
   CASE ('SUPERBEE')
      I_FLUX_LIMITER=SUPERBEE_LIMITER
   CASE ('MINMOD')
      I_FLUX_LIMITER=MINMOD_LIMITER
   CASE ('CHARM')
      I_FLUX_LIMITER=CHARM_LIMITER
   CASE ('MP5')
      I_FLUX_LIMITER=MP5_LIMITER
   CASE DEFAULT
      WRITE(MESSAGE,'(A,A,A)')  "ERROR: FLUX_LIMITER, ",TRIM(FLUX_LIMITER),", is not recognized."
      WRITE(MESSAGE,'(A)')      "       Available options are: 'CENTRAL', GODUNOV', 'SUPERBEE', 'MINMOD', 'CHARM', 'MP5'."
      CALL SHUTDOWN(MESSAGE) ; RETURN
END SELECT

! Set the lower limit of the extinction coefficient

EC_LL = VISIBILITY_FACTOR/MAXIMUM_VISIBILITY

IF (HUMIDITY<0._EB) HUMIDITY=40._EB

! Do not allow predefined SURF as DEFAULT

IF (TRIM(SURF_DEFAULT)=='OPEN'               .OR. &
    TRIM(SURF_DEFAULT)=='MIRROR'             .OR. &
    TRIM(SURF_DEFAULT)=='INTERPOLATED'       .OR. &
    TRIM(SURF_DEFAULT)=='PERIODIC'           .OR. &
    TRIM(SURF_DEFAULT)=='HVAC'               .OR. &
    TRIM(SURF_DEFAULT)=='MASSLESS TRACER'    .OR. &
    TRIM(SURF_DEFAULT)=='DROPLET'            .OR. &
    TRIM(SURF_DEFAULT)=='EVACUATION_OUTFLOW' .OR. &
    TRIM(SURF_DEFAULT)=='MASSLESS TARGET'         ) THEN
   WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with MISC. Cannot set predefined SURF as SURF_DEFAULT'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

FUEL_SMIX_INDEX=2

H_F_REFERENCE_TEMPERATURE = H_F_REFERENCE_TEMPERATURE + TMPM

END SUBROUTINE READ_MISC


!> \brief Read the WIND namelist line

SUBROUTINE READ_WIND

USE MATH_FUNCTIONS, ONLY: GET_RAMP_INDEX
USE PHYSICAL_FUNCTIONS, ONLY: MONIN_OBUKHOV_SIMILARITY
REAL(EB) :: CORIOLIS_VECTOR(3)=0._EB,FORCE_VECTOR(3)=0._EB,OBUKHOV_LENGTH,L,ZZZ,ZETA,Z_0,AERODYNAMIC_ROUGHNESS,SPEED,DIRECTION,&
            REFERENCE_HEIGHT,Z_REF,U_STAR,THETA_0,THETA_STAR,TMP,U,REFERENCE_TEMPERATURE,THETA_REF,TMP_REF,P_REF,RHO_REF,ZSW,ZFW
INTEGER :: NM,N
CHARACTER(LABEL_LENGTH) :: RAMP_FVX_T,RAMP_FVY_T,RAMP_FVZ_T,RAMP_U0_T,RAMP_V0_T,RAMP_W0_T,&
                           RAMP_U0_Z,RAMP_V0_Z,RAMP_W0_Z,RAMP_TMP0_Z,RAMP_DIRECTION,RAMP_SPEED
TYPE(RESERVED_RAMPS_TYPE), POINTER :: RRP,RRP2
TYPE(SURFACE_TYPE), POINTER :: SF=>NULL()
EQUIVALENCE(Z_0,AERODYNAMIC_ROUGHNESS)
EQUIVALENCE(Z_REF,REFERENCE_HEIGHT)
EQUIVALENCE(TMP_REF,REFERENCE_TEMPERATURE)
EQUIVALENCE(L,OBUKHOV_LENGTH)

NAMELIST /WIND/ CORIOLIS_VECTOR,DIRECTION,DT_MEAN_FORCING,DT_MEAN_FORCING_2,FORCE_VECTOR,FYI,GEOSTROPHIC_WIND,GROUND_LEVEL,L,&
                LAPSE_RATE,LATITUDE,&
                POTENTIAL_TEMPERATURE_CORRECTION,RAMP_DIRECTION,RAMP_FVX_T,RAMP_FVY_T,RAMP_FVZ_T,RAMP_SPEED,&
                RAMP_TMP0_Z,RAMP_U0_T,RAMP_U0_Z,RAMP_V0_T,RAMP_V0_Z,RAMP_W0_T,RAMP_W0_Z,&
                SPEED,SPONGE_CELLS,STRATIFICATION,THETA_STAR,TMP_REF,U_STAR,U0,USE_ATMOSPHERIC_INTERPOLATION,V0,W0,Z_0,Z_REF,&
                MEAN_FORCING,OBUKHOV_LENGTH,REFERENCE_HEIGHT,REFERENCE_TEMPERATURE  ! Backward compatibility

! Default values

DIRECTION           = 270._EB   ! westerly wind
LAPSE_RATE          = 0._EB     ! K/m
MEAN_FORCING        = .FALSE.
OBUKHOV_LENGTH      = 0._EB     ! m
RAMP_DIRECTION      = 'null'
RAMP_SPEED          = 'null'
RAMP_U0_T           = 'null'
RAMP_V0_T           = 'null'
RAMP_W0_T           = 'null'
RAMP_U0_Z           = 'null'
RAMP_V0_Z           = 'null'
RAMP_W0_Z           = 'null'
RAMP_TMP0_Z         = 'null'
RAMP_FVX_T          = 'null'
RAMP_FVY_T          = 'null'
RAMP_FVZ_T          = 'null'
SPEED               = -1._EB    ! m/s
SPONGE_CELLS        = 0
THETA_STAR          = 0._EB     ! K
TMP_REF             = -1._EB    ! C
U_STAR              = -1._EB    ! m/s
U0                  = 0._EB     ! m/s
V0                  = 0._EB     ! m/s
W0                  = 0._EB     ! m/s
Z_0                 = -1._EB    ! m
Z_REF               = 2._EB     ! m

! Initial read of the WIND line

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
WIND_LOOP: DO
   CALL CHECKREAD('WIND',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT WIND_LOOP
   READ(LU_INPUT,WIND,END=23,ERR=24,IOSTAT=IOS)
   24 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with WIND line') ; RETURN ; ENDIF
ENDDO WIND_LOOP
23 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! Check that we are not over specifying Z_0.

IF (Z_0<0._EB) THEN
   ! Z_0 has not been specified on the WIND line,
   ! therefore, pick up Z_0 specified on first SURF line using ABL model
   DO N=0,N_SURF
      SF=>SURFACE(N)
      IF (SF%ABL_MODEL .AND. SF%Z_0>TWO_EPSILON_EB .AND. Z_0<-TWO_EPSILON_EB) Z_0 = SF%Z_0
   ENDDO
   ! If nothing specified on SURF, then use 0.03 m as default
   IF (Z_0<-TWO_EPSILON_EB) Z_0 = 0.03_EB
ELSE
   ! Z_0 has been specified on WIND,
   ! make sure this does not conflict with any SURF lines with ABL model
   DO N=0,N_SURF
      SF=>SURFACE(N)
      IF (SF%ABL_MODEL .AND. ABS(SF%Z_0-Z_0)>TWO_EPSILON_EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' Z_0 must match WIND line Z_0'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO
ENDIF

! Determine the appropriate wind speed if the user specifies SPEED or U_STAR. If
! the user specifies U0, V0, or W0, MEAN_FORCING will not be invoked unless the
! user specifies it.

IF (U_STAR>0._EB) SPEED = U_STAR*LOG((Z_REF-GROUND_LEVEL)/Z_0)/VON_KARMAN_CONSTANT
DIRECTION = DIRECTION*PI/180._EB
IF (SPEED>0._EB) THEN
   MEAN_FORCING(1:2) = .TRUE.
   IF (RAMP_DIRECTION/='null') THEN
      U0 = SPEED
      V0 = SPEED
   ELSE
      U0 = -SPEED*SIN(DIRECTION)
      V0 = -SPEED*COS(DIRECTION)
   ENDIF
ENDIF

! Miscellaneous

FVEC = FORCE_VECTOR
OVEC = CORIOLIS_VECTOR
IF (LATITUDE>-90.1_EB .AND. LATITUDE<90.1_EB) THEN
   OVEC(1) = 0._EB
   OVEC(2) = EARTH_OMEGA*COS(LATITUDE*PI/180._EB)
   OVEC(3) = EARTH_OMEGA*SIN(LATITUDE*PI/180._EB)
ENDIF

! Velocity, force, and gravity ramps

I_RAMP_DIRECTION = 0
I_RAMP_SPEED     = 0
I_RAMP_U0_T = 0
I_RAMP_V0_T = 0
I_RAMP_W0_T = 0
I_RAMP_U0_Z = 0
I_RAMP_V0_Z = 0
I_RAMP_W0_Z = 0
I_RAMP_TMP0_Z = 0
I_RAMP_FVX_T= 0
I_RAMP_FVY_T= 0
I_RAMP_FVZ_T= 0

IF (RAMP_DIRECTION/='null') THEN  ! create dummy time RAMPs for U0 and V0 and fill in later
   RAMP_U0_T = RAMP_DIRECTION
   RAMP_V0_T = RAMP_DIRECTION
ENDIF
IF (RAMP_SPEED/='null') THEN  ! create dummy time RAMPs for U0 and V0 and fill in later
   RAMP_U0_T = RAMP_SPEED
   RAMP_V0_T = RAMP_SPEED
ENDIF
IF (RAMP_U0_T/='null') CALL GET_RAMP_INDEX(RAMP_U0_T,'TIME',I_RAMP_U0_T,DUPLICATE_RAMP=.TRUE.)
IF (RAMP_V0_T/='null') CALL GET_RAMP_INDEX(RAMP_V0_T,'TIME',I_RAMP_V0_T,DUPLICATE_RAMP=.TRUE.)
IF (RAMP_W0_T/='null') CALL GET_RAMP_INDEX(RAMP_W0_T,'TIME',I_RAMP_W0_T)
IF (RAMP_U0_Z/='null') CALL GET_RAMP_INDEX(RAMP_U0_Z,'PROFILE',I_RAMP_U0_Z)
IF (RAMP_V0_Z/='null') CALL GET_RAMP_INDEX(RAMP_V0_Z,'PROFILE',I_RAMP_V0_Z)
IF (RAMP_W0_Z/='null') CALL GET_RAMP_INDEX(RAMP_W0_Z,'PROFILE',I_RAMP_W0_Z)
IF (RAMP_TMP0_Z/='null') CALL GET_RAMP_INDEX(RAMP_TMP0_Z,'PROFILE',I_RAMP_TMP0_Z)
IF (RAMP_FVX_T/='null') CALL GET_RAMP_INDEX(RAMP_FVX_T,'TIME',I_RAMP_FVX_T)
IF (RAMP_FVY_T/='null') CALL GET_RAMP_INDEX(RAMP_FVY_T,'TIME',I_RAMP_FVY_T)
IF (RAMP_FVZ_T/='null') CALL GET_RAMP_INDEX(RAMP_FVZ_T,'TIME',I_RAMP_FVZ_T)
IF (RAMP_SPEED/='null') CALL GET_RAMP_INDEX(RAMP_SPEED,'TIME',I_RAMP_SPEED)
IF (RAMP_DIRECTION/='null') CALL GET_RAMP_INDEX(RAMP_DIRECTION,'TIME',I_RAMP_DIRECTION)

IF (STRATIFICATION) THEN

   IF (HVAC_SOLVE) THEN
      ZSW = MIN(ZS_MIN-DZS_MAX,NODE_Z_MIN)
      ZFW = MAX(ZF_MAX+DZF_MAX,NODE_Z_MAX)
   ELSE
      ZSW = ZS_MIN
      ZFW = ZF_MAX
   ENDIF

   IF (RAMP_TMP0_Z=='null' .AND. ABS(OBUKHOV_LENGTH)<1.E-10_EB) THEN
      N_RESERVED_RAMPS = N_RESERVED_RAMPS + 1
      RRP => RESERVED_RAMPS(N_RESERVED_RAMPS)
      ALLOCATE(RRP%INDEPENDENT_DATA(2))
      ALLOCATE(RRP%DEPENDENT_DATA(2))
      RRP%INDEPENDENT_DATA(1) = ZSW
      RRP%INDEPENDENT_DATA(2) = ZFW
      RRP%DEPENDENT_DATA(1)   = (TMPA+LAPSE_RATE*(ZSW-GROUND_LEVEL))/TMPA
      RRP%DEPENDENT_DATA(2)   = (TMPA+LAPSE_RATE*(ZFW-GROUND_LEVEL))/TMPA
      RRP%NUMBER_DATA_POINTS = 2
      RAMP_TMP0_Z = 'RSRVD TEMPERATURE PROFILE'
      CALL GET_RAMP_INDEX(RAMP_TMP0_Z,'PROFILE',I_RAMP_TMP0_Z)
   ENDIF

   IF (ABS(OBUKHOV_LENGTH)>1.E-10_EB) THEN
      N_RESERVED_RAMPS = N_RESERVED_RAMPS + 1
      RRP => RESERVED_RAMPS(N_RESERVED_RAMPS)
      RRP%NUMBER_DATA_POINTS = 51
      N_RESERVED_RAMPS = N_RESERVED_RAMPS + 1
      RRP2 => RESERVED_RAMPS(N_RESERVED_RAMPS)
      RRP2%NUMBER_DATA_POINTS = 51
      ALLOCATE(RRP%INDEPENDENT_DATA(51))
      ALLOCATE(RRP%DEPENDENT_DATA(51))
      ALLOCATE(RRP2%INDEPENDENT_DATA(51))
      ALLOCATE(RRP2%DEPENDENT_DATA(51))
      IF (U_STAR<0._EB) U_STAR = VON_KARMAN_CONSTANT*SPEED/LOG((Z_REF-GROUND_LEVEL)/Z_0)
      IF (TMP_REF<0._EB) THEN
         TMP_REF = TMPA
      ELSE
         TMP_REF = TMP_REF + TMPM  ! C to K
      ENDIF
      RHO_REF = 1.2_EB
      P_REF = P_INF - RHO_REF*GRAV*(Z_REF-GROUND_LEVEL)
      THETA_REF = TMP_REF*(P_INF/P_REF)**0.286_EB
      IF (ABS(THETA_STAR)<1.E-10_EB) THEN
         THETA_0 = THETA_REF/(1._EB+U_STAR**2*LOG((Z_REF-GROUND_LEVEL)/Z_0)/(GRAV*VON_KARMAN_CONSTANT**2*OBUKHOV_LENGTH))
         THETA_STAR = U_STAR**2*THETA_0/(GRAV*VON_KARMAN_CONSTANT*OBUKHOV_LENGTH)
      ELSE
         THETA_0 = THETA_REF - THETA_STAR*LOG((Z_REF-GROUND_LEVEL)/Z_0)/VON_KARMAN_CONSTANT
      ENDIF
      TMPA = THETA_0  ! Make the ground temperature the new ambient temperature
      DO I=1,51
         ZETA = ZSW + (I-1)*(ZFW-ZSW)/50.
         ZZZ  = Z_0*EXP(LOG((ZFW-GROUND_LEVEL)/Z_0)*(ZETA-ZSW)/(ZFW-ZSW))
         CALL MONIN_OBUKHOV_SIMILARITY(ZZZ,Z_0,OBUKHOV_LENGTH,U_STAR,THETA_STAR,THETA_0,U,TMP)
         RRP%INDEPENDENT_DATA(I) = GROUND_LEVEL + ZZZ
         RRP%DEPENDENT_DATA(I)   = TMP/TMPA
         RRP2%INDEPENDENT_DATA(I) = GROUND_LEVEL + ZZZ
         RRP2%DEPENDENT_DATA(I)   = U/SPEED
      ENDDO
      RAMP_TMP0_Z = 'RSRVD TEMPERATURE PROFILE'
      CALL GET_RAMP_INDEX(RAMP_TMP0_Z,'PROFILE',I_RAMP_TMP0_Z)
      RAMP_U0_Z = 'RSRVD VELOCITY PROFILE'
      CALL GET_RAMP_INDEX(RAMP_U0_Z,'PROFILE',I_RAMP_U0_Z)
      RAMP_V0_Z = 'RSRVD VELOCITY PROFILE'
      CALL GET_RAMP_INDEX(RAMP_V0_Z,'PROFILE',I_RAMP_V0_Z)
   ENDIF

   ! Add a RAMP for the vertical profile of pressure (the values are computed in INIT)

   N_RESERVED_RAMPS = N_RESERVED_RAMPS + 1
   CALL GET_RAMP_INDEX('RSRVD PRESSURE PROFILE','PROFILE',I_RAMP_P0_Z)
   RRP => RESERVED_RAMPS(N_RESERVED_RAMPS)
   ALLOCATE(RRP%INDEPENDENT_DATA(2))
   ALLOCATE(RRP%DEPENDENT_DATA(2))
   RRP%INDEPENDENT_DATA(1) = ZSW
   RRP%INDEPENDENT_DATA(2) = ZFW
   RRP%DEPENDENT_DATA(1) = 0._EB     ! Dummy values to be filled in later
   RRP%DEPENDENT_DATA(2) = 1._EB     ! Dummy values to be filled in later
   RRP%NUMBER_DATA_POINTS = 2

ENDIF

! External kinetic energy

H0 = 0.5_EB*(U0**2+V0**2+W0**2)

! Allocation for mean forcing (required here, instead of init, because of hole feature)

IF (ANY(MEAN_FORCING)) THEN
   N_MEAN_FORCING_BINS = NINT((ZF_MAX-ZS_MIN)/CHARACTERISTIC_CELL_SIZE)
   ALLOCATE(MEAN_FORCING_SUM_U_VOL(N_MEAN_FORCING_BINS),STAT=IZERO) ; CALL ChkMemErr('READ','MEAN_FORCING_SUM_U_VOL',IZERO)
   ALLOCATE(MEAN_FORCING_SUM_V_VOL(N_MEAN_FORCING_BINS),STAT=IZERO) ; CALL ChkMemErr('READ','MEAN_FORCING_SUM_V_VOL',IZERO)
   ALLOCATE(MEAN_FORCING_SUM_W_VOL(N_MEAN_FORCING_BINS),STAT=IZERO) ; CALL ChkMemErr('READ','MEAN_FORCING_SUM_W_VOL',IZERO)
   ALLOCATE(MEAN_FORCING_SUM_VOL_X(N_MEAN_FORCING_BINS),STAT=IZERO) ; CALL ChkMemErr('READ','MEAN_FORCING_SUM_VOL_X',IZERO)
   ALLOCATE(MEAN_FORCING_SUM_VOL_Y(N_MEAN_FORCING_BINS),STAT=IZERO) ; CALL ChkMemErr('READ','MEAN_FORCING_SUM_VOL_Y',IZERO)
   ALLOCATE(MEAN_FORCING_SUM_VOL_Z(N_MEAN_FORCING_BINS),STAT=IZERO) ; CALL ChkMemErr('READ','MEAN_FORCING_SUM_VOL_Z',IZERO)
   ALLOCATE(U_MEAN_FORCING(N_MEAN_FORCING_BINS),STAT=IZERO)         ; CALL ChkMemErr('READ','U_MEAN_FORCING',IZERO)
   ALLOCATE(V_MEAN_FORCING(N_MEAN_FORCING_BINS),STAT=IZERO)         ; CALL ChkMemErr('READ','V_MEAN_FORCING',IZERO)
   ALLOCATE(W_MEAN_FORCING(N_MEAN_FORCING_BINS),STAT=IZERO)         ; CALL ChkMemErr('READ','W_MEAN_FORCING',IZERO)
   DO NM=1,NMESHES
      IF (MYID/=PROCESS(NM) .OR. EVACUATION_ONLY(NM)) CYCLE
      M=>MESHES(NM)
      ALLOCATE(M%MEAN_FORCING_CELL(0:M%IBP1,0:M%JBP1,0:M%KBP1),STAT=IZERO) ; CALL ChkMemErr('READ','MEAN_FORCING_CELL',IZERO)
      M%MEAN_FORCING_CELL=.TRUE.
      ALLOCATE(M%K_MEAN_FORCING(1:M%KBAR),STAT=IZERO) ; CALL ChkMemErr('READ','K_MEAN_FORCING',IZERO)
      DO K=1,M%KBAR
         M%K_MEAN_FORCING(K) = INT((M%ZC(K)-ZS_MIN)/(ZF_MAX-ZS_MIN)*REAL(N_MEAN_FORCING_BINS,EB)) + 1
      ENDDO
   ENDDO
ENDIF

! Min value of temperature

IF (LAPSE_RATE < 0._EB) TMPMIN = MIN(TMPMIN,TMPA+LAPSE_RATE*(ZFW-GROUND_LEVEL))

END SUBROUTINE READ_WIND


!> \brief Process WIND input parameters

SUBROUTINE PROC_WIND

! This short routine takes a time ramp of wind speed and direction and converts to Cartesian ramps for U0, V0

REAL(EB) :: THETA,COS_THETA,SIN_THETA,SPEED_FACTOR
INTEGER :: I,N_PTS

IF (I_RAMP_DIRECTION/=0 .OR. I_RAMP_SPEED/=0) THEN
   IF (I_RAMP_DIRECTION/=0) N_PTS = RAMPS(I_RAMP_DIRECTION)%NUMBER_INTERPOLATION_POINTS+1
   IF (I_RAMP_SPEED    /=0) N_PTS = RAMPS(I_RAMP_SPEED    )%NUMBER_INTERPOLATION_POINTS+1
   DO I=0,N_PTS
      IF (I_RAMP_DIRECTION/=0) THEN
         THETA = RAMPS(I_RAMP_DIRECTION)%INTERPOLATED_DATA(I)*PI/180._EB
         SIN_THETA = -SIN(THETA)
         COS_THETA = -COS(THETA)
      ELSE
         SIN_THETA = 1._EB
         COS_THETA = 1._EB
      ENDIF
      IF (I_RAMP_SPEED/=0) THEN
         SPEED_FACTOR = RAMPS(I_RAMP_SPEED)%INTERPOLATED_DATA(I)
      ELSE
         SPEED_FACTOR = 1._EB
      ENDIF
      RAMPS(I_RAMP_U0_T)%INTERPOLATED_DATA(I) = SPEED_FACTOR*SIN_THETA
      RAMPS(I_RAMP_V0_T)%INTERPOLATED_DATA(I) = SPEED_FACTOR*COS_THETA
   ENDDO
ENDIF

IF (ANY(ABS(GEOSTROPHIC_WIND)>TWO_EPSILON_EB)) THEN
   IF (ALL(ABS(OVEC)<TWO_EPSILON_EB)) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: GEOSTROPHIC_WIND requires Coriolis force, set LATITUDE on WIND line'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   FVEC(1) = - GEOSTROPHIC_WIND(2)*RHOA*2._EB*EARTH_OMEGA*SIN(LATITUDE*PI/180._EB)
   FVEC(2) =   GEOSTROPHIC_WIND(1)*RHOA*2._EB*EARTH_OMEGA*SIN(LATITUDE*PI/180._EB)
ENDIF

END SUBROUTINE PROC_WIND


!> \brief Read the DUMP namelist line, parameters associated with output files

SUBROUTINE READ_DUMP

USE DEVICE_VARIABLES, ONLY: DEVICE_TYPE,DEVICE,N_DEVC
REAL(EB) :: DT_DEFAULT,T_DEVC_LINE_END,DT_DEVC_LINE
INTEGER :: N,SIG_FIGS,SIG_FIGS_EXP
TYPE(DEVICE_TYPE), POINTER :: DV
NAMELIST /DUMP/ CFL_FILE,CLIP_RESTART_FILES,COLUMN_DUMP_LIMIT,CTRL_COLUMN_LIMIT,&
                DEVC_COLUMN_LIMIT,DT_CPU,DT_CTRL,DT_BNDF,DT_DEVC,DT_DEVC_LINE,DT_FLUSH,&
                DT_HRR,DT_ISOF,DT_MASS,DT_PART,DT_PL3D,DT_PROF,DT_RESTART,DT_RADF,DT_SL3D,DT_SLCF,EB_PART_FILE,&
                FLUSH_FILE_BUFFERS,GET_CUTCELLS_VERBOSE,MASS_FILE,MAXIMUM_PARTICLES,MMS_TIMER,&
                NFRAMES,PLOT3D_PART_ID, &
                PLOT3D_QUANTITY,PLOT3D_SPEC_ID,PLOT3D_VELO_INDEX,RENDER_FILE,SIG_FIGS,SIG_FIGS_EXP,SMOKE3D, &
                SMOKE3D_QUANTITY,SMOKE3D_SPEC_ID,STATUS_FILES,STORE_SPECIES_FLUX,SUPPRESS_DIAGNOSTICS,&
                T_DEVC_LINE_END,T_RADF_BEGIN,T_RADF_END,UVW_TIMER,VELOCITY_ERROR_FILE,WRITE_XYZ

! Set defaults

MAXIMUM_PARTICLES   = 1000000
MMS_TIMER          = 1.E10_EB
NFRAMES            = 1000
PLOT3D_QUANTITY(1) = 'TEMPERATURE'
PLOT3D_QUANTITY(2) = 'U-VELOCITY'
PLOT3D_QUANTITY(3) = 'V-VELOCITY'
PLOT3D_QUANTITY(4) = 'W-VELOCITY'
PLOT3D_QUANTITY(5) = 'HRRPUV'
PLOT3D_PART_ID     = 'null'
PLOT3D_SPEC_ID     = 'null'
PLOT3D_VELO_INDEX  = 0
RENDER_FILE        = 'null'
SMOKE3D_QUANTITY(1)= 'DENSITY'       ; SMOKE3D_SPEC_ID(1) = 'SOOT'
SMOKE3D_QUANTITY(2)= 'HRRPUV'        ; SMOKE3D_SPEC_ID(2) = 'null'
SMOKE3D_QUANTITY(3)= 'TEMPERATURE'   ; SMOKE3D_SPEC_ID(3) = 'null'
SMOKE3D_QUANTITY(4)= 'DENSITY'       ; SMOKE3D_SPEC_ID(4) = 'CARBON DIOXIDE'
SIG_FIGS           = 8
SIG_FIGS_EXP       = 3
IF (NMESHES>32) THEN
   SUPPRESS_DIAGNOSTICS = .TRUE.
ELSE
   SUPPRESS_DIAGNOSTICS = .FALSE.
ENDIF
UVW_TIMER          = 1.E10_EB

DT_GEOM      =  1.E10_EB
DT_BNDF      = -1._EB
DT_CPU       = 1000000._EB
DT_RESTART   = 1000000._EB
DT_FLUSH     = -1._EB
DT_DEVC      = -1._EB
DT_DEVC_LINE = -1._EB
DT_HRR       = -1._EB
DT_ISOF      = -1._EB
DT_MASS      = -1._EB
DT_PART      = -1._EB
DT_PL3D      =  1.E10_EB
DT_PROF      = -1._EB
DT_SLCF      = -1._EB
DT_SL3D      = 0.2_EB*(T_END-T_BEGIN)
DT_CTRL      = -1._EB
T_RADF_BEGIN = T_BEGIN
T_RADF_END   = T_END
DT_RADF      = (T_RADF_END-T_RADF_BEGIN)/5._EB
T_DEVC_LINE_END=-1.E10_EB

! Read the DUMP line

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
DUMP_LOOP: DO
   CALL CHECKREAD('DUMP',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT DUMP_LOOP
   READ(LU_INPUT,DUMP,END=23,ERR=24,IOSTAT=IOS)
   24 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with DUMP line') ; RETURN ; ENDIF
ENDDO DUMP_LOOP
23 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! Backward compatibility

IF (DT_DEVC_LINE>0._EB .OR. T_DEVC_LINE_END>-1.E5_EB) THEN
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE==0) CYCLE
      IF (T_DEVC_LINE_END<-1.E5_EB) T_DEVC_LINE_END = T_END + TWO_EPSILON_EB
      DV%STATISTICS_START = T_DEVC_LINE_END - DT_DEVC_LINE
      DV%STATISTICS_END   = T_DEVC_LINE_END
   ENDDO
ENDIF

! Set output time intervals

DT_DEFAULT = (T_END - T_BEGIN)/REAL(NFRAMES,EB)

IF (DT_BNDF < 0._EB) THEN ; DT_BNDF = 2._EB*DT_DEFAULT ; ELSE ; DT_BNDF = DT_BNDF /TIME_SHRINK_FACTOR ; ENDIF
IF (DT_DEVC < 0._EB) THEN ; DT_DEVC = DT_DEFAULT       ; ELSE ; DT_DEVC = DT_DEVC /TIME_SHRINK_FACTOR ; ENDIF
IF (DT_HRR  < 0._EB) THEN ; DT_HRR  = DT_DEFAULT       ; ELSE ; DT_HRR  = DT_HRR  /TIME_SHRINK_FACTOR ; ENDIF
IF (DT_ISOF < 0._EB) THEN ; DT_ISOF = DT_DEFAULT       ; ELSE ; DT_ISOF = DT_ISOF /TIME_SHRINK_FACTOR ; ENDIF
IF (DT_MASS < 0._EB) THEN ; DT_MASS = DT_DEFAULT       ; ELSE ; DT_MASS = DT_MASS /TIME_SHRINK_FACTOR ; ENDIF
IF (DT_PART < 0._EB) THEN ; DT_PART = DT_DEFAULT       ; ELSE ; DT_PART = DT_PART /TIME_SHRINK_FACTOR ; ENDIF
IF (DT_PROF < 0._EB) THEN ; DT_PROF = DT_DEFAULT       ; ELSE ; DT_PROF = DT_PROF /TIME_SHRINK_FACTOR ; ENDIF
IF (DT_SLCF < 0._EB) THEN ; DT_SLCF = DT_DEFAULT       ; ELSE ; DT_SLCF = DT_SLCF /TIME_SHRINK_FACTOR ; ENDIF
IF (DT_CTRL < 0._EB) THEN ; DT_CTRL = DT_DEFAULT       ; ELSE ; DT_CTRL = DT_CTRL /TIME_SHRINK_FACTOR ; ENDIF
IF (DT_FLUSH< 0._EB) THEN ; DT_FLUSH= DT_DEFAULT       ; ELSE ; DT_FLUSH= DT_FLUSH/TIME_SHRINK_FACTOR ; ENDIF

! Check Plot3D QUANTITIES

PLOOP: DO N=1,5
   CALL GET_QUANTITY_INDEX(PLOT3D_SMOKEVIEW_LABEL(N),PLOT3D_SMOKEVIEW_BAR_LABEL(N),PLOT3D_QUANTITY_INDEX(N),I_DUM(1), &
                           PLOT3D_Y_INDEX(N),PLOT3D_Z_INDEX(N),PLOT3D_PART_INDEX(N),I_DUM(2),I_DUM(3),I_DUM(4),I_DUM(5),'PLOT3D', &
                           PLOT3D_QUANTITY(N),'null',PLOT3D_SPEC_ID(N),PLOT3D_PART_ID(N),'null','null','null','null',&
                           -1._EB,I_DUM(6))
   IF (OUTPUT_QUANTITY(PLOT3D_QUANTITY_INDEX(N))%INTEGRATED_PARTICLES) PL3D_PARTICLE_FLUX = .TRUE.
ENDDO PLOOP

! Check SMOKE3D viability

IF (TWO_D .OR. SOLID_PHASE_ONLY) SMOKE3D = .FALSE.

IF (SMOKE3D) THEN
   QUANTITY_LOOP: DO N=1,4
      CALL GET_QUANTITY_INDEX(SMOKE3D_SMOKEVIEW_LABEL(N),SMOKE3D_SMOKEVIEW_BAR_LABEL(N),SMOKE3D_QUANTITY_INDEX(N),I_DUM(1), &
                              SMOKE3D_Y_INDEX(N),SMOKE3D_Z_INDEX(N),I_DUM(2),I_DUM(3),I_DUM(4),I_DUM(5),I_DUM(6),'SMOKE3D', &
                              SMOKE3D_QUANTITY(N),'null',SMOKE3D_SPEC_ID(N),'null','null','null','null','null',-1._EB,I_DUM(6))
   ENDDO QUANTITY_LOOP
ENDIF

! Set format of real number output

WRITE(FMT_R,'(A,I2.2,A,I2.2,A,I1.1)') 'ES',SIG_FIGS+SIG_FIGS_EXP+4,'.',SIG_FIGS-1,'E',SIG_FIGS_EXP

END SUBROUTINE READ_DUMP


!> \brief Read the SPEC namelist lines containing parameters for gas species

SUBROUTINE READ_SPEC

USE MATH_FUNCTIONS, ONLY : GET_RAMP_INDEX
USE PHYSICAL_FUNCTIONS, ONLY : WATER_VAPOR_MASS_FRACTION, GET_SPECIFIC_GAS_CONSTANT
USE PROPERTY_DATA, ONLY: GAS_PROPS,FED_PROPS,CHECK_PREDEFINED
USE SOOT_ROUTINES
REAL(EB) :: MW,SIGMALJ,EPSILONKLJ,VISCOSITY,CONDUCTIVITY,DIFFUSIVITY,MASS_EXTINCTION_COEFFICIENT, &
            SPECIFIC_HEAT,REFERENCE_ENTHALPY,REFERENCE_TEMPERATURE,FIC_CONCENTRATION,FLD_LETHAL_DOSE,&
            SPECIFIC_HEAT_LIQUID,DENSITY_LIQUID,VAPORIZATION_TEMPERATURE,HEAT_OF_VAPORIZATION,MELTING_TEMPERATURE,&
            H_V_REFERENCE_TEMPERATURE,MEAN_DIAMETER,CONDUCTIVITY_SOLID,DENSITY_SOLID,ENTHALPY_OF_FORMATION,&
            MASS_FRACTION_COND_0,MASS_FRACTION_0,&
            CONVERSION,PR_GAS,CONDUCTIVITY_LIQUID,VISCOSITY_LIQUID,BETA_LIQUID,H_F_IN,THERMOPHORETIC_DIAMETER
REAL(EB):: MASS_FRACTION(MAX_SPECIES),VOLUME_FRACTION(MAX_SPECIES),MIN_DIAMETER,MAX_DIAMETER
REAL(EB), ALLOCATABLE, DIMENSION(:) :: ZZ_GET
INTEGER  :: N_SPEC_READ,N,NN,NNN,NS2,NR,N_SPEC_READ_2,N_SUB_SPECIES,NS,N_BINS,N_COPY,N_FOUND,MINT_SPECIES,Y_S,Z_S
INTEGER, ALLOCATABLE, DIMENSION(:) :: Y_INDEX
LOGICAL  :: LUMPED_COMPONENT_ONLY,AEROSOL,BACKGROUND,&
            DEFINED_BACKGROUND,REAC_FUEL_READ=.FALSE.,PRIMITIVE,COPY_LUMPED
LOGICAL, ALLOCATABLE, DIMENSION(:) :: PREDEFINED,PREDEFINED_SMIX,NEW_PRIMITIVE
CHARACTER(LABEL_LENGTH) :: RAMP_CP,RAMP_CP_L,RAMP_K,RAMP_MU,RAMP_D,RADCAL_ID,RAMP_G_F,SPEC_ID(MAX_SPECIES)

CHARACTER(LABEL_LENGTH), ALLOCATABLE, DIMENSION(:) :: PREDEFINED_SPEC_ID,SPEC_ID_READ
CHARACTER(FORMULA_LENGTH) :: FORMULA
TYPE(SPECIES_TYPE), POINTER :: SS=>NULL()
TYPE(SPECIES_MIXTURE_TYPE), POINTER :: SM=>NULL()
NAMELIST /SPEC/ AEROSOL,BACKGROUND,BETA_LIQUID,CONDUCTIVITY,CONDUCTIVITY_LIQUID,CONDUCTIVITY_SOLID,COPY_LUMPED, &
                DENSITY_LIQUID,DENSITY_SOLID,DIFFUSIVITY,ENTHALPY_OF_FORMATION,EPSILONKLJ,FIC_CONCENTRATION,FLD_LETHAL_DOSE, &
                FORMULA,FYI,HEAT_OF_VAPORIZATION,H_V_REFERENCE_TEMPERATURE,ID,LUMPED_COMPONENT_ONLY,&
                MASS_EXTINCTION_COEFFICIENT,MASS_FRACTION,MASS_FRACTION_COND_0,MASS_FRACTION_0,MAX_DIAMETER,MEAN_DIAMETER,&
                MELTING_TEMPERATURE,MIN_DIAMETER,MW,N_BINS,PR_GAS,PRIMITIVE,RADCAL_ID,&
                RAMP_CP,RAMP_CP_L,RAMP_D,RAMP_G_F,RAMP_K,RAMP_MU,REFERENCE_ENTHALPY,REFERENCE_TEMPERATURE,SIGMALJ,SPEC_ID,&
                SPECIFIC_HEAT,SPECIFIC_HEAT_LIQUID,THERMOPHORETIC_DIAMETER,VAPORIZATION_TEMPERATURE,VISCOSITY,VISCOSITY_LIQUID,&
                VOLUME_FRACTION

IF (SIMPLE_CHEMISTRY) THEN
   MINT_SPECIES = 10
ELSE
   MINT_SPECIES = 5
ENDIF
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
N_SPECIES=0

COUNT_SPEC_LINES: DO
   READ(LU_INPUT,NML=SPEC,END=19,ERR=20,IOSTAT=IOS)
   MINT_SPECIES=MINT_SPECIES+1
20 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with SPECies number',N_SPECIES+1,', line number',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   N_SPECIES = N_SPECIES+1
ENDDO COUNT_SPEC_LINES
19 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

!Allocate species inputs
ALLOCATE(PREDEFINED(MINT_SPECIES))
ALLOCATE(PREDEFINED_SMIX(1:MINT_SPECIES))
ALLOCATE(NEW_PRIMITIVE(0:MINT_SPECIES))
NEW_PRIMITIVE=.FALSE.
ALLOCATE(PREDEFINED_SPEC_ID(MINT_SPECIES))
ALLOCATE(SPEC_ID_READ(MINT_SPECIES))

! Create predefined inputs related to simple chemistry mode

PREDEFINED = .FALSE.
PREDEFINED_SMIX = .FALSE.

N_SPEC_READ = 0
N_TRACKED_SPECIES = 1

IF (SIMPLE_CHEMISTRY) THEN
   N_SPECIES = 9
   PREDEFINED(1:9)       = .TRUE.
   PREDEFINED_SPEC_ID(1) = REACTION(1)%FUEL
   PREDEFINED_SPEC_ID(2) = 'NITROGEN'
   PREDEFINED_SPEC_ID(3) = 'OXYGEN'
   PREDEFINED_SPEC_ID(4) = 'CARBON DIOXIDE'
   PREDEFINED_SPEC_ID(5) = 'WATER VAPOR'
   PREDEFINED_SPEC_ID(6) = 'CARBON MONOXIDE'
   PREDEFINED_SPEC_ID(7) = 'SOOT'
   PREDEFINED_SPEC_ID(8) = 'HYDROGEN'
   PREDEFINED_SPEC_ID(9) = 'HYDROGEN CYANIDE'
   SELECT CASE(N_SIMPLE_CHEMISTRY_REACTIONS)
      CASE(1) ; PREDEFINED_SMIX(1:3) = .TRUE. ; N_TRACKED_SPECIES = 3
      CASE(2) ; PREDEFINED_SMIX(1:4) = .TRUE. ; N_TRACKED_SPECIES = 4
   END SELECT
   IF (REACTION(1)%C <=0._EB .AND. REACTION(1)%H <=0._EB) PREDEFINED_SMIX(2)=.FALSE.
ELSE
   ! If not simple chemistry look for a background species and if none force creation of AIR lumped species
   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   CHECK_BACKGROUND_LOOP: DO
      BACKGROUND = .FALSE.
      READ(LU_INPUT,NML=SPEC,END=21,IOSTAT=IOS)
      IF (BACKGROUND) EXIT
   ENDDO CHECK_BACKGROUND_LOOP
21 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   IF (BACKGROUND) THEN
      N_SPECIES = 0
      DEFINED_BACKGROUND = .TRUE.
   ELSE
      N_SPECIES = 4
      PREDEFINED(1:4)       = .TRUE.
      PREDEFINED_SPEC_ID(1) = 'NITROGEN'
      PREDEFINED_SPEC_ID(2) = 'OXYGEN'
      PREDEFINED_SPEC_ID(3) = 'CARBON DIOXIDE'
      PREDEFINED_SPEC_ID(4) = 'WATER VAPOR'
      PREDEFINED_SMIX(1) = .TRUE.
      DEFINED_BACKGROUND = .FALSE.
   ENDIF
ENDIF

! Pass 1: Count SPEC lines determine number of primitive and tracked species and check for errors

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_SPEC_LOOP: DO
   CALL SET_SPEC_DEFAULT
   CALL CHECKREAD('SPEC',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_SPEC_LOOP
   READ(LU_INPUT,NML=SPEC,END=29,IOSTAT=IOS)
   N_SPEC_READ = N_SPEC_READ + 1
   SPEC_ID_READ(N_SPEC_READ) = ID

   IF (ID=='null') THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Species ',N_SPEC_READ, ' needs a name (ID=...)'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Prevent use of 'AIR' unless a new BACKGROUND has been defined.

   IF (ID=='AIR' .AND. .NOT. DEFINED_BACKGROUND) THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': Cannot redefine AIR without defining a BACKGROUND species'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Make sure both ramps and constant values have not been given

   IF (SPECIFIC_HEAT > 0._EB .AND. RAMP_CP/='null') THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(ID),': Cannot specify both SPECIFIC_HEAT and RAMP_CP'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (SPECIFIC_HEAT_LIQUID > 0._EB .AND. RAMP_CP_L/='null') THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(ID),': Cannot specify both SPECIFIC_HEAT_LIQUID and RAMP_CP_L'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (CONDUCTIVITY > 0._EB .AND. RAMP_K/='null') THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(ID),': Cannot specify both CONDUCTIVITY and RAMP_K'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (DIFFUSIVITY > 0._EB .AND. RAMP_D/='null') THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(ID),': Cannot specify both DIFFUSIVITY and RAMP_D'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (VISCOSITY > 0._EB .AND. RAMP_MU/='null') THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(ID),': Cannot specify both VISCOSISTY and RAMP_MU'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! REFERENCE_ENTHALPY requires additional parameters

   IF (REFERENCE_ENTHALPY > -2.E20_EB .AND. (SPECIFIC_HEAT < 0._EB .AND. RAMP_CP=='null')) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(ID),': REFERENCE_ENTHALPY requires SPECIFIC_HEAT or RAMP_CP'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   DO NN = 1,N_SPEC_READ-1
      IF (ID==SPEC_ID_READ(NN)) THEN
         WRITE(MESSAGE,'(A,I0,A,I0,A)') 'ERROR: Species ',N_SPEC_READ,' has the same ID as species ',NN, '.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO

   IF (BACKGROUND) THEN
      IF (LUMPED_COMPONENT_ONLY) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: Cannot define a LUMPED_COMPONENT_ONLY species as the BACKGROUND species'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (SIMPLE_CHEMISTRY) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: Cannot define a BACKGROUND species if using the simple chemistry'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF
   IF (LUMPED_COMPONENT_ONLY .AND. MASS_FRACTION_0>0._EB) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: Cannot define MASS_FRACTION_0 for a LUMPED_COMPONENT_ONLY species'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (PRIMITIVE) THEN
      IF (SPEC_ID(1)/='null' .AND. SPEC_ID(2)=='null') THEN
         NEW_PRIMITIVE(N_SPEC_READ)=.TRUE.
         IF (.NOT. CHECK_PREDEFINED(SPEC_ID(1))) THEN
            WRITE(MESSAGE,'(A,I0,A,I0,A)') 'ERROR: SPEC_ID(1) for species ',N_SPEC_READ,' must be a predefined species'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ELSEIF (SPEC_ID(1)/='null' .AND. SPEC_ID(2)/='null') THEN
         WRITE(MESSAGE,'(A,I0,A,I0,A)') 'ERROR: Species ',N_SPEC_READ,' is declared PRIMITIVE and has more than one SPEC_ID given'
         CALL SHUTDOWN(MESSAGE)          ; RETURN
      ENDIF
   ENDIF

   IF (SPEC_ID(1)=='null' .OR. PRIMITIVE) THEN
      N_SPECIES = N_SPECIES+1
      IF (SIMPLE_CHEMISTRY) THEN
         IF(TRIM(ID)/=TRIM(REACTION(1)%FUEL)) THEN
            IF (.NOT. LUMPED_COMPONENT_ONLY .AND. .NOT. BACKGROUND) N_TRACKED_SPECIES = N_TRACKED_SPECIES + 1
         ENDIF
      ELSE
         IF (.NOT. LUMPED_COMPONENT_ONLY .AND. .NOT. BACKGROUND) N_TRACKED_SPECIES = N_TRACKED_SPECIES + 1
      ENDIF
   ELSE
      IF (SIMPLE_CHEMISTRY) THEN
         IF(TRIM(ID)/=TRIM(REACTION(1)%FUEL)) N_TRACKED_SPECIES = N_TRACKED_SPECIES + 1
      ELSE
         IF (.NOT. BACKGROUND) N_TRACKED_SPECIES = N_TRACKED_SPECIES + 1
      ENDIF
   ENDIF

   ! If predefined species, check to see if the species has already been defined.
   IF (PREDEFINED_SMIX(1)) THEN
      DO NN=1,N_SPECIES-1
         IF (TRIM(PREDEFINED_SPEC_ID(NN))==TRIM(ID)) THEN
            IF (.NOT. SIMPLE_CHEMISTRY) THEN
               IF (SPEC_ID(1)/='null') THEN
                  WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Species ',N_SPEC_READ+1, &
                                             '.  Lumped species has the same ID as a predefined species'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
            ELSE
               IF (SPEC_ID(1)/='null') THEN
                  IF (TRIM(ID)/=TRIM(REACTION(1)%FUEL)) THEN
                     WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Species ',N_SPEC_READ+1, &
                                                '.  Lumped species has the same ID as a predefined species'
                     CALL SHUTDOWN(MESSAGE) ; RETURN
                  ELSE
                     PREDEFINED_SMIX(2) = .FALSE.
                     REAC_FUEL_READ = .TRUE.
                  ENDIF
               ELSE
                  IF (TRIM(ID)==TRIM(REACTION(1)%FUEL)) REAC_FUEL_READ = .TRUE.
               ENDIF
            ENDIF
            PREDEFINED(NN) = .FALSE.
            N_SPECIES = N_SPECIES - 1
            EXIT
         ENDIF
      ENDDO
   ENDIF
ENDDO COUNT_SPEC_LOOP

29 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (SIMPLE_CHEMISTRY .AND. .NOT. (REAC_FUEL_READ .OR. SIMPLE_FUEL_DEFINED)) THEN
   WRITE(MESSAGE,'(A,A,A)') 'ERROR: Simple chemistry fuel, ',TRIM(REACTION(1)%FUEL),', not defined on REAC or SPEC.'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

! Allocate the primitive species array.
ALLOCATE(SPECIES(N_SPECIES),STAT=IZERO)
CALL ChkMemErr('READ','SPECIES',IZERO)

ALLOCATE(Y_INDEX(N_SPECIES))

! Pass 2: read and process primitive species
N = 0
N_SPEC_READ_2 = N_SPEC_READ
N_SPEC_READ = 0

PRIMITIVE_SPEC_READ_LOOP: DO WHILE (N_SPEC_READ < N_SPEC_READ_2 .OR. N < N_SPECIES)
   N = N + 1

   CALL SET_SPEC_DEFAULT

   IF (PREDEFINED(N)) THEN
      ID = PREDEFINED_SPEC_ID(N)
      LUMPED_COMPONENT_ONLY = .TRUE.
   ELSE
      READ(LU_INPUT,NML=SPEC)
      N_SPEC_READ = N_SPEC_READ + 1
      IF (SIMPLE_CHEMISTRY) THEN
         IF(TRIM(ID)==TRIM(REACTION(1)%FUEL)) PREDEFINED_SMIX(2)=.FALSE.
      ENDIF

      IF (SPEC_ID(1)/='null' .AND. .NOT. NEW_PRIMITIVE(N_SPEC_READ)) THEN
         N = N - 1
         CYCLE PRIMITIVE_SPEC_READ_LOOP
      ENDIF

   ENDIF

   SS => SPECIES(N)

   SS%K_USER                      = CONDUCTIVITY
   SS%CONDUCTIVITY_SOLID          = CONDUCTIVITY_SOLID
   SS%D_USER                      = DIFFUSIVITY
   SS%DENSITY_SOLID               = DENSITY_SOLID
   SS%EPSK                        = EPSILONKLJ
   SS%FIC_CONCENTRATION           = FIC_CONCENTRATION*1.E-6_EB
   SS%FLD_LETHAL_DOSE             = FLD_LETHAL_DOSE*1.E-6_EB
   SS%FORMULA                     = FORMULA
   SS%H_F                         = ENTHALPY_OF_FORMATION*1000._EB
   SS%ID                          = ID
   SS%RADCAL_ID                   = RADCAL_ID
   SS%MASS_EXTINCTION_COEFFICIENT = MAX(0._EB,MASS_EXTINCTION_COEFFICIENT)
   SS%MEAN_DIAMETER               = MEAN_DIAMETER
   SS%THERMOPHORETIC_DIAMETER     = THERMOPHORETIC_DIAMETER
   SS%MU_USER                     = VISCOSITY
   SS%MW                          = MW
   SS%PR_USER                     = PR_GAS
   SS%RAMP_CP                     = RAMP_CP
   SS%RAMP_CP_L                   = RAMP_CP_L
   SS%RAMP_D                      = RAMP_D
   SS%RAMP_K                      = RAMP_K
   SS%RAMP_G_F                    = RAMP_G_F
   SS%RAMP_MU                     = RAMP_MU
   IF (REFERENCE_TEMPERATURE < -TMPM) REFERENCE_TEMPERATURE = 25._EB
   SS%REFERENCE_TEMPERATURE       = REFERENCE_TEMPERATURE + TMPM
   SS%SIG                         = SIGMALJ
   SS%SPECIFIC_HEAT               = SPECIFIC_HEAT*1000._EB
   SS%REFERENCE_ENTHALPY          = REFERENCE_ENTHALPY*1000._EB
   SS%YY0                         = MAX(0._EB,MASS_FRACTION_0)

   SS%DENSITY_LIQUID              = DENSITY_LIQUID
   SS%BETA_LIQUID                 = BETA_LIQUID
   SS%K_LIQUID                    = CONDUCTIVITY_LIQUID
   SS%MU_LIQUID                   = VISCOSITY_LIQUID

   IF ((HEAT_OF_VAPORIZATION >  0._EB .AND. SPECIFIC_HEAT_LIQUID <= 0._EB .AND. RAMP_CP_L=='null') .OR. &
       (HEAT_OF_VAPORIZATION <= 0._EB .AND. SPECIFIC_HEAT_LIQUID >  0._EB .AND. RAMP_CP_L/='null')) THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ' ,N_SPEC_READ, &
                                ': If one of SPECIFIC_HEAT_LIQUID (or RAMP_CL_L) or HEAT_OF_VAPORIZATION defined, both must be'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (SPECIFIC_HEAT_LIQUID > 0._EB .OR. RAMP_CP_L/='null') THEN
      IF (MELTING_TEMPERATURE < -TMPM) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ' ,N_SPEC_READ,': MELTING_TEMPERATURE not set'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      SS%SPECIFIC_HEAT_LIQUID        = SPECIFIC_HEAT_LIQUID*1000._EB
      SS%HEAT_OF_VAPORIZATION        = HEAT_OF_VAPORIZATION*1000._EB
      SS%TMP_MELT = MELTING_TEMPERATURE + TMPM
      IF (H_V_REFERENCE_TEMPERATURE < -TMPM) H_V_REFERENCE_TEMPERATURE = MELTING_TEMPERATURE
      SS%H_V_REFERENCE_TEMPERATURE = H_V_REFERENCE_TEMPERATURE + 273.15_EB
      IF (VAPORIZATION_TEMPERATURE< -TMPM) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ' ,N_SPEC_READ,': VAPORIZATION_TEMPERATURE not set'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      SS%TMP_V = VAPORIZATION_TEMPERATURE + TMPM
   ENDIF

   IF (AEROSOL) SS%CONDENSABLE = CHECK_CONDENSABLE(SS%TMP_V,SS%ID)

   IF (SS%CONDENSABLE) THEN
      IF (N_BINS>0) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': Cannot set both N_BINS > 0 when CONDENSABLE=.TRUE.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (LUMPED_COMPONENT_ONLY) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': A CONDENSABLE species cannot have LUMPED_COMPONENT_ONLY=.TRUE.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (ANY(SPEC_ID/='null')) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': A CONDENSABLE species cannot be a lumped species'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      N_TRACKED_SPECIES = N_TRACKED_SPECIES + 1
   ENDIF

   IF (N_BINS > 0) THEN
      N_AGGLOMERATION_SPECIES = N_AGGLOMERATION_SPECIES + 1
      IF (N_BINS < 2) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': N_BINS must be >=2'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (.NOT. AEROSOL) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': AEROSOL must be .TRUE. to use N_BINS'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (ABS(MEAN_DIAMETER - 1.E-6_EB) < TWO_EPSILON_EB) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': Do not specify MEAN_DIAMETER and N_BINS'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (MAX_DIAMETER < 0._EB) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': MAX_DIAMETER not set'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (MIN_DIAMETER < 0._EB) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': MIN_DIAMETER not set'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (MAX_DIAMETER <= MIN_DIAMETER) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': MAX_DIAMETER <= MIN_DIAMETER'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (.NOT. LUMPED_COMPONENT_ONLY) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': LUMPED_COMPONENT_ONLY must be .TRUE. to use N_BINS'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      N_PARTICLE_BINS(N_AGGLOMERATION_SPECIES) = N_BINS
      MAX_PARTICLE_DIAMETER(N_AGGLOMERATION_SPECIES) = MAX_DIAMETER
      MIN_PARTICLE_DIAMETER(N_AGGLOMERATION_SPECIES) = MIN_DIAMETER
      AGGLOMERATION_SPEC_INDEX(N_AGGLOMERATION_SPECIES)=N
      N_TRACKED_SPECIES=N_TRACKED_SPECIES+N_PARTICLE_BINS(N_AGGLOMERATION_SPECIES)
      SS%AGGLOMERATING = .TRUE.
   ELSE
      IF (AEROSOL .AND. MEAN_DIAMETER < 0._EB) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: SPEC ',N_SPEC_READ,': No MEAN_DIAMETER given.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF

   IF (NEW_PRIMITIVE(N_SPEC_READ)) THEN
      SS%PROP_ID = SPEC_ID(1)
   ELSE
      SS%PROP_ID = ID
   ENDIF
   H_F_IN = SS%H_F
   CALL GAS_PROPS(SS%PROP_ID,SS%SIG,SS%EPSK,SS%PR_USER,SS%MW,SS%FORMULA,SS%LISTED,SS%ATOMS,SS%H_F,SS%RADCAL_ID)
   IF (SIMPLE_CHEMISTRY) THEN
      IF (TRIM(SS%ID)==TRIM(REACTION(1)%FUEL) .AND. .NOT. SS%LISTED) SS%H_F = H_F_IN
   ENDIF
   CALL FED_PROPS(SS%PROP_ID,SS%FLD_LETHAL_DOSE,SS%FIC_CONCENTRATION)

   IF (SS%H_F > -1.E23_EB) SS%EXPLICIT_H_F=.TRUE.

   IF (SS%SPECIFIC_HEAT > 0._EB) THEN
      ! H_F overrides REFERENCE_ENTHALPY
      IF (ENTHALPY_OF_FORMATION > -1.E23_EB) THEN
         SS%REFERENCE_ENTHALPY = SS%H_F/SS%MW*1000._EB - SS%SPECIFIC_HEAT*H_F_REFERENCE_TEMPERATURE
      ELSE
         IF (SS%REFERENCE_ENTHALPY < -1.E20_EB) SS%REFERENCE_ENTHALPY = SS%SPECIFIC_HEAT * SS%REFERENCE_TEMPERATURE
         SS%H_F = (SS%REFERENCE_ENTHALPY + SS%SPECIFIC_HEAT * (H_F_REFERENCE_TEMPERATURE-SS%REFERENCE_TEMPERATURE))*SS%MW*0.001_EB
         !Adjust SS%REFERENCE_ENTHALPY to 0 K
         SS%REFERENCE_ENTHALPY = SS%REFERENCE_ENTHALPY - SS%SPECIFIC_HEAT * SS%REFERENCE_TEMPERATURE
      ENDIF
   ENDIF

   IF (SS%RAMP_CP/='null' .AND. SS%REFERENCE_ENTHALPY < -1.E20_EB) SS%REFERENCE_ENTHALPY = 0._EB

   IF (TRIM(SS%FORMULA)=='null') WRITE(SS%FORMULA,'(A,I0)') 'SPEC_',N

   ! For simple chemistry Determine if the species is the one specified on the REAC line(s)

   IF (SIMPLE_CHEMISTRY) THEN
      IF (TRIM(ID)==TRIM(REACTION(1)%FUEL)) THEN
         FUEL_INDEX = N
         WRITE(FORMULA,'(A,I0)') 'SPEC_',N
         IF (TRIM(SS%FORMULA)==TRIM(FORMULA)) SS%MW = REACTION(1)%MW_FUEL
      ENDIF
      IF (TRIM(ID)=='SOOT') SS%MW = REACTION(1)%MW_SOOT
   ENDIF

   SS%RCON = R0/SS%MW
   SS%MODE = GAS_SPECIES

   ! Special processing of certain species

   SELECT CASE (ID)
      CASE('WATER VAPOR')
         H2O_INDEX = N
         IF (MASS_FRACTION_0 > 0._EB .AND. LUMPED_COMPONENT_ONLY) THEN
            WRITE(MESSAGE,'(A)') 'WARNING: MASS_FRACTION_0 specified for WATER VAPOR with LUMPED_COMPONENT_ONLY = .TRUE.'
            IF (MYID==0) WRITE(LU_ERR,'(A)') TRIM(MESSAGE)
         ENDIF
         IF (PREDEFINED_SMIX(1)) Y_H2O_INFTY = WATER_VAPOR_MASS_FRACTION(HUMIDITY,MIN(373.15_EB,TMPA),P_INF)
      CASE('CARBON DIOXIDE')
         CO2_INDEX = N
      CASE('CARBON MONOXIDE')
         CO_INDEX = N
      CASE('OXYGEN')
         O2_INDEX = N
      CASE('NITROGEN')
         N2_INDEX = N
      CASE('HYDROGEN')
         H2_INDEX = N
      CASE('HYDROGEN CYANIDE')
         HCN_INDEX = N
      CASE('NITRIC OXIDE')
         NO_INDEX = N
      CASE('NITROGEN DIOXIDE')
         NO2_INDEX = N
      CASE('SOOT')
         SOOT_INDEX = N
         IF (MASS_EXTINCTION_COEFFICIENT < 0._EB) SS%MASS_EXTINCTION_COEFFICIENT = 8700._EB
   END SELECT

   IF (SS%RADCAL_ID=='SOOT' .AND. SOOT_INDEX==0) SOOT_INDEX = N
   IF (SS%ID=='SOOT' .AND. AEROSOL_AL2O3) SS%DENSITY_SOLID = 4000.
   IF (AEROSOL) SS%MODE = AEROSOL_SPECIES

   ! Get ramps
   IF (SS%RAMP_CP/='null') THEN
      CALL GET_RAMP_INDEX(SS%RAMP_CP,'TEMPERATURE',NR)
      SS%RAMP_CP_INDEX = NR
   ENDIF
   IF (SS%RAMP_CP_L/='null') THEN
      CALL GET_RAMP_INDEX(SS%RAMP_CP_L,'TEMPERATURE',NR)
      SS%RAMP_CP_L_INDEX = NR
   ENDIF
   IF (SS%RAMP_D/='null') THEN
      CALL GET_RAMP_INDEX(SS%RAMP_D,'TEMPERATURE',NR)
      SS%RAMP_D_INDEX = NR
   ENDIF
   IF (SS%RAMP_G_F/='null') THEN
      CALL GET_RAMP_INDEX(SS%RAMP_G_F,'TEMPERATURE',NR)
      SS%RAMP_G_F_INDEX = NR
   ENDIF
   IF (SS%RAMP_K/='null') THEN
      CALL GET_RAMP_INDEX(SS%RAMP_K,'TEMPERATURE',NR)
      SS%RAMP_K_INDEX = NR
   ENDIF
   IF (SS%RAMP_MU/='null') THEN
      CALL GET_RAMP_INDEX(SS%RAMP_MU,'TEMPERATURE',NR)
      SS%RAMP_MU_INDEX = NR
   ENDIF
ENDDO PRIMITIVE_SPEC_READ_LOOP

IF (N_AGGLOMERATION_SPECIES > 0) CALL INITIALIZE_AGGLOMERATION

! IMPORTANT: define number of total tracked scalars
N_TOTAL_SCALARS=N_TRACKED_SPECIES+N_PASSIVE_SCALARS

! Pass 3: process tracked species (primitive and lumped)
ALLOCATE(SPECIES_MIXTURE(1:N_TOTAL_SCALARS),STAT=IZERO)
CALL ChkMemErr('READ','SPECIES_MIXTURE',IZERO)

! Process non-predefined mixtures first
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
N = 1
DEFINED_BACKGROUND = .FALSE.
N_SPEC_READ = 0
N_COPY = 0
N_FOUND = 1
N_AGGLOMERATION_SPECIES = 0
TRACKED_SPEC_LOOP_1: DO WHILE (N_FOUND <= N_TRACKED_SPECIES .OR. .NOT. DEFINED_BACKGROUND)
   IF (PREDEFINED_SMIX(N)) THEN
      CALL SET_SPEC_DEFAULT
      IF (N==1) BACKGROUND = .TRUE.
   ELSE
      FIND_TRACKED: DO
         CALL SET_SPEC_DEFAULT
         READ(LU_INPUT,NML=SPEC)
         N_SPEC_READ = N_SPEC_READ + 1
         IF (LUMPED_COMPONENT_ONLY .AND. N_BINS < 0) CYCLE FIND_TRACKED
         IF (COPY_LUMPED) THEN
            IF (N_BINS >0) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ' ,TRIM(SM%ID),', cannot specify both COPY_LUMPED and N_BINS.'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (BACKGROUND) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ' ,TRIM(SM%ID),', cannot specify both COPY_LUMPED and BACKGROUND.'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            N_COPY = N_COPY+1
         ENDIF
         IF (ANY(MASS_FRACTION>0._EB) .AND. ANY(VOLUME_FRACTION>0._EB)) THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ' ,TRIM(SM%ID),', cannot specify both MASS_FRACTION and VOLUME_FRACTION.'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         EXIT
      ENDDO FIND_TRACKED
      IF (N_BINS > 0) THEN
         N_AGGLOMERATION_SPECIES = N_AGGLOMERATION_SPECIES + 1
         AGGLOMERATION_SMIX_INDEX(N_AGGLOMERATION_SPECIES) = N
         SPECIES_MIXTURE(N)%AGGLOMERATION_INDEX=N_AGGLOMERATION_SPECIES
         DO NNN=1,N_PARTICLE_BINS(N_AGGLOMERATION_SPECIES)
            MEAN_DIAMETER = 2._EB*PARTICLE_RADIUS(N_AGGLOMERATION_SPECIES,NNN)
            SPEC_ID(1)=SPECIES(AGGLOMERATION_SPEC_INDEX(N_AGGLOMERATION_SPECIES))%ID
            WRITE(ID,'(A,A,I0)') TRIM(SPECIES(AGGLOMERATION_SPEC_INDEX(N_AGGLOMERATION_SPECIES))%ID),'_',NNN
            MASS_FRACTION(1)=1._EB
            CALL DEFINE_MIXTURE
            N = N + 1
         ENDDO
         N = N - 1
      ELSE
         CALL DEFINE_MIXTURE
         IF (TRIM(ID)=='WATER VAPOR') H2O_SMIX_INDEX = N
         IF (SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX > 0) THEN
            IF (SPECIES(SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX)%CONDENSABLE) THEN
               SPECIES_MIXTURE(N)%CONDENSATION_SMIX_INDEX = N + 1
               SPECIES_MIXTURE(N)%DEPOSITING=.FALSE.
               SPEC_ID(1) = SPECIES_MIXTURE(N)%ID
               MASS_FRACTION(1)=1._EB
               N = N + 1
               WRITE(ID,'(A,A)') TRIM(ID),'_COND'
               CALL DEFINE_MIXTURE
               SPECIES_MIXTURE(N)%DEPOSITING=.TRUE.
               SPECIES_MIXTURE(N)%EVAPORATION_SMIX_INDEX = N - 1
               SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX=SPECIES_MIXTURE(N-1)%SINGLE_SPEC_INDEX
               SM%ZZ0 = MAX(0._EB,MASS_FRACTION_COND_0)
               IF (SPECIES(SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX)%AWM_INDEX < 0) THEN
                  N_SURFACE_DENSITY_SPECIES = N_SURFACE_DENSITY_SPECIES + 1
                  SPECIES(SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX)%AWM_INDEX = N_SURFACE_DENSITY_SPECIES
               ENDIF
            ENDIF
         ENDIF
      ENDIF

      IF (SIMPLE_CHEMISTRY) THEN
         SM => SPECIES_MIXTURE(N)
         IF (TRIM(SM%ID)==TRIM(REACTION(1)%FUEL)) THEN
            FUEL_SMIX_INDEX = N
            IF (ABS(SM%ATOMS(1)+SM%ATOMS(6)+SM%ATOMS(7)+SM%ATOMS(8) - SUM(SM%ATOMS)) > SPACING(SUM(SM%ATOMS))) THEN
               WRITE(MESSAGE,'(A)') 'ERROR: Fuel FORMULA for SIMPLE_CHEMISTRY can only contain C,H,O, and N'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ELSE
               REACTION(1)%C = SM%ATOMS(6)
               REACTION(1)%H = SM%ATOMS(1)
               REACTION(1)%O = SM%ATOMS(8)
               REACTION(1)%N = SM%ATOMS(7)
               REACTION(1)%MW_FUEL = SM%MW
            ENDIF
            IF (REACTION(1)%C<=TWO_EPSILON_EB .AND. REACTION(1)%H<=TWO_EPSILON_EB) THEN
               WRITE(MESSAGE,'(A)') 'ERROR: Must specify fuel chemistry using C and/or H when using simple chemistry'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDIF
      ENDIF
   ENDIF
   IF (BACKGROUND) THEN
      DEFINED_BACKGROUND = .TRUE.
      IF (N==1) N = N + 1
   ELSE
      N = N + 1
   ENDIF
   N_FOUND = N + N_COPY
ENDDO TRACKED_SPEC_LOOP_1

IF (N_COPY >= 1) NNN = N

! Process predefined mixtures second

IF (ANY(PREDEFINED_SMIX)) THEN
   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   N = 1
   DEFINED_BACKGROUND = .FALSE.
   TRACKED_SPEC_LOOP_2: DO WHILE (N <= N_TOTAL_SCALARS .OR. .NOT. DEFINED_BACKGROUND)
      IF (PREDEFINED_SMIX(N)) THEN
         CALL SET_SPEC_DEFAULT
         CALL SETUP_PREDEFINED_SMIX(N)
         IF (N==1) BACKGROUND=.TRUE.
         CALL DEFINE_MIXTURE
      ELSE
         BACKGROUND = .FALSE.
      ENDIF
      IF (BACKGROUND) THEN
         DEFINED_BACKGROUND = .TRUE.
         IF (N==1) N = N + 1
      ELSE
         N = N + 1
      ENDIF
   ENDDO TRACKED_SPEC_LOOP_2
ENDIF

REWIND (LU_INPUT)

TRACKED_SPEC_LOOP_3: DO NN = 1, N_COPY
   FIND_TRACKED_2: DO
      CALL SET_SPEC_DEFAULT
      READ(LU_INPUT,NML=SPEC)
      IF (.NOT. COPY_LUMPED) CYCLE FIND_TRACKED_2
      DO N=1,NNN-1
         IF (SPECIES_MIXTURE(N)%ID==SPEC_ID(1)) THEN
            SPECIES_MIXTURE(NNN) = SPECIES_MIXTURE(N)
            SPECIES_MIXTURE(NNN)%ID = ID
            EXIT FIND_TRACKED_2
         ELSE
            IF (N==NNN-1) THEN
               WRITE(MESSAGE,'(A,A,A,A)') 'ERROR: SPEC ' ,TRIM(ID),', cannot find tracked species ',TRIM(SPEC_ID(1))
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDIF
      ENDDO
   ENDDO FIND_TRACKED_2
   NNN = NNN + 1
ENDDO TRACKED_SPEC_LOOP_3

REWIND (LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! Normalize the initial mass fractions of the lumped species if necessary
IF (SUM(SPECIES_MIXTURE(2:N_TRACKED_SPECIES)%ZZ0) > 1._EB) &
   SPECIES_MIXTURE(2:N_TRACKED_SPECIES)%ZZ0 = SPECIES_MIXTURE(2:N_TRACKED_SPECIES)%ZZ0/ &
                                          SUM(SPECIES_MIXTURE(2:N_TRACKED_SPECIES)%ZZ0)

SPECIES_MIXTURE(1)%ZZ0 = 1._EB - SUM(SPECIES_MIXTURE(2:N_TRACKED_SPECIES)%ZZ0)

DEPOSITION = ANY(SPECIES_MIXTURE%DEPOSITING) .AND. DEPOSITION

!Deallocate species inputs
DEALLOCATE(PREDEFINED)
DEALLOCATE(PREDEFINED_SMIX)
DEALLOCATE(NEW_PRIMITIVE)
DEALLOCATE(PREDEFINED_SPEC_ID)
DEALLOCATE(SPEC_ID_READ)
DEALLOCATE(Y_INDEX)

! Setup the array to convert the tracked species array to array of all primitive species

ALLOCATE(Z2Y(N_SPECIES,N_TRACKED_SPECIES),STAT=IZERO)
CALL ChkMemErr('READ','Z2Y',IZERO)
Z2Y = 0._EB

DO N=1,N_TRACKED_SPECIES
   SM => SPECIES_MIXTURE(N)
   DO NN=1,N_SPECIES
      Z2Y(NN,N) = SM%MASS_FRACTION(NN)
   ENDDO
ENDDO

! Set up the arrays of molecular weights

ALLOCATE(MWR_Z(N_TRACKED_SPECIES),STAT=IZERO)
CALL ChkMemErr('READ','MW_AVG_Y',IZERO)


MWR_Z = 1._EB/SPECIES_MIXTURE%MW

ALLOCATE(ZZ_GET(N_TRACKED_SPECIES))
ZZ_GET = SPECIES_MIXTURE%ZZ0
CALL GET_SPECIFIC_GAS_CONSTANT(ZZ_GET,RSUM0)
DEALLOCATE(ZZ_GET)

MW_MIN = MINVAL(SPECIES_MIXTURE(1:N_TRACKED_SPECIES)%MW)
MW_MAX = MAXVAL(SPECIES_MIXTURE(1:N_TRACKED_SPECIES)%MW)

! Compute background density from other background quantities

RHOA = P_INF/(TMPA*RSUM0)

! Compute constant-temperature specific heats

GM1OG = (GAMMA-1._EB)/GAMMA
CP_GAMMA = SPECIES_MIXTURE(1)%RCON/GM1OG
CPOPR = CP_GAMMA/PR

!If SOOT_OXIDATION is enabled make sure to save accumulation on the wall and check that it is an AEROSOL species
IF (.NOT. SOOT_OXIDATION) RETURN

IF (SIMPLE_CHEMISTRY) THEN
   WRITE(MESSAGE,'(A)') 'ERROR: Cannot use simple chemistry with SOOT_OXIDATION.'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

IF (SOOT_INDEX < 0) THEN
   WRITE(MESSAGE,'(A)') 'ERROR: SOOT_OXIDATION set without SOOT as a species'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

SS => SPECIES(SOOT_INDEX)

IF (SS%MODE /= AEROSOL_SPECIES)  THEN
   WRITE(MESSAGE,'(A)') 'ERROR: SOOT_OXIDATION set without SOOT defined as an AEROSOL species'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

ALLOCATE (NU_SOOT_OX(1:N_TRACKED_SPECIES))
NU_SOOT_OX = 0._EB

DO N = 1, N_TRACKED_SPECIES
   IF (SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX==O2_INDEX) NU_SOOT_OX(N) = -(SS%ATOMS(1) * 0.25_EB + SS%ATOMS(6)) * MW_O2 / SS%MW
   IF (SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX==H2O_INDEX) NU_SOOT_OX(N) = SS%ATOMS(1) * 0.5_EB * MW_H2O / SS%MW
   IF (SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX==CO2_INDEX) NU_SOOT_OX(N) = SS%ATOMS(6) * MW_CO2 / SS%MW
END DO

CALL GET_SPEC_OR_SMIX_INDEX('SOOT',Y_S,Z_S)

N_SURFACE_DENSITY_SPECIES = N_SURFACE_DENSITY_SPECIES + 1
SPECIES(Y_S)%AWM_INDEX = N_SURFACE_DENSITY_SPECIES

IF (ANY(N_PARTICLE_BINS > 0)) THEN
   DO N=1,N_TRACKED_SPECIES
      IF(SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX==SOOT_INDEX) THEN
         N_SURFACE_DENSITY_SPECIES = N_SURFACE_DENSITY_SPECIES + 1
         SPECIES_MIXTURE(N)%AWM_INDEX = N_SURFACE_DENSITY_SPECIES
      ENDIF
   ENDDO
ENDIF

CONTAINS


!> \brief Create a species mixture

SUBROUTINE DEFINE_MIXTURE

USE PROPERTY_DATA, ONLY: GET_FORMULA_WEIGHT

IF (BACKGROUND) THEN
   NN = 1
ELSE
   IF (N==1) N = N + 1
   NN = N
ENDIF

CONVERSION = 0._EB

SM => SPECIES_MIXTURE(NN)

IF (SPEC_ID(1)=='null') THEN
   SPEC_ID(1) = ID
   VOLUME_FRACTION(1) = 1.0_EB
ELSE
   SM%K_USER                      = CONDUCTIVITY
   SM%D_USER                      = DIFFUSIVITY
   SM%EPSK                        = EPSILONKLJ
   SM%FIC_CONCENTRATION           = FIC_CONCENTRATION
   SM%FLD_LETHAL_DOSE             = FLD_LETHAL_DOSE
   SM%MU_USER                     = VISCOSITY
   SM%PR_USER                     = PR_GAS
   SM%RAMP_CP                     = RAMP_CP
   SM%RAMP_D                      = RAMP_D
   SM%RAMP_G_F                    = RAMP_G_F
   SM%RAMP_K                      = RAMP_K
   SM%RAMP_MU                     = RAMP_MU
   IF (REFERENCE_TEMPERATURE < -TMPM) REFERENCE_TEMPERATURE = 25._EB
   SM%REFERENCE_TEMPERATURE       = REFERENCE_TEMPERATURE + TMPM
   SM%SIG                         = SIGMALJ
   SM%SPECIFIC_HEAT               = SPECIFIC_HEAT*1000._EB
   SM%REFERENCE_ENTHALPY          = REFERENCE_ENTHALPY*1000._EB
   SM%H_F                         = ENTHALPY_OF_FORMATION*1000._EB

   IF (SM%RAMP_CP/='null' .AND. SM%REFERENCE_ENTHALPY < -1.E20_EB) SM%REFERENCE_ENTHALPY = 0._EB

   ! Get ramps
   IF (SM%RAMP_CP/='null') THEN
      CALL GET_RAMP_INDEX(SM%RAMP_CP,'TEMPERATURE',NR)
      SM%RAMP_CP_INDEX = NR
   ENDIF
   IF (SM%RAMP_D/='null') THEN
      CALL GET_RAMP_INDEX(SM%RAMP_D,'TEMPERATURE',NR)
      SM%RAMP_D_INDEX = NR
   ENDIF
   IF (SM%RAMP_G_F/='null') THEN
      CALL GET_RAMP_INDEX(SM%RAMP_D,'TEMPERATURE',NR)
      SM%RAMP_G_F_INDEX = NR
   ENDIF
   IF (SM%RAMP_K/='null') THEN
      CALL GET_RAMP_INDEX(SM%RAMP_K,'TEMPERATURE',NR)
      SM%RAMP_K_INDEX = NR
   ENDIF
   IF (SM%RAMP_MU/='null') THEN
      CALL GET_RAMP_INDEX(SM%RAMP_MU,'TEMPERATURE',NR)
      SM%RAMP_MU_INDEX = NR
   ENDIF
ENDIF

SM%ID = ID
SM%ZZ0 = MAX(0._EB,MASS_FRACTION_0)

! Count the number of species included in the mixture

N_SUB_SPECIES = 0
COUNT_SPEC: DO NS=1,N_SPECIES
   IF (TRIM(SPEC_ID(NS)) /= 'null') THEN
      N_SUB_SPECIES = N_SUB_SPECIES + 1
   ELSE
      EXIT
   ENDIF
ENDDO COUNT_SPEC

IF (N_SUB_SPECIES == 1) THEN
   MASS_FRACTION=0._EB
   MASS_FRACTION(1)=1._EB
   VOLUME_FRACTION=0._EB
ENDIF

! Allocate arrays to store the species id, mass, volume fractions

ALLOCATE (SM%SPEC_ID(N_SPECIES),STAT=IZERO)
ALLOCATE (SM%VOLUME_FRACTION(N_SPECIES),STAT=IZERO)
ALLOCATE (SM%MASS_FRACTION(N_SPECIES),STAT=IZERO)

SM%SPEC_ID         = 'null'
SM%VOLUME_FRACTION = 0._EB
SM%MASS_FRACTION   = 0._EB
Y_INDEX = -1
DO NS = 1,N_SUB_SPECIES
   FIND_SPEC_ID: DO NS2 = 1,N_SPECIES
      IF ((.NOT. NEW_PRIMITIVE(N_SPEC_READ) .AND. TRIM(SPECIES(NS2)%ID) == TRIM(SPEC_ID(NS))) .OR. &
          (      NEW_PRIMITIVE(N_SPEC_READ) .AND. TRIM(SPECIES(NS2)%ID) == TRIM(ID))) THEN
         SM%SPEC_ID(NS2) = SPECIES(NS2)%ID
         Y_INDEX(NS)  = NS2
         IF (N_SUB_SPECIES==1) THEN
            SM%FORMULA = SPECIES(NS2)%FORMULA
            SM%SINGLE_SPEC_INDEX=NS2
         ENDIF
         IF (SPECIES(NS2)%MODE == AEROSOL_SPECIES) THEN
            IF (N_SUB_SPECIES == 1) THEN
               SM%DEPOSITING = .TRUE.
               SM%MEAN_DIAMETER = MEAN_DIAMETER
               IF (THERMOPHORETIC_DIAMETER > 0._EB) THEN
                  SM%THERMOPHORETIC_DIAMETER = THERMOPHORETIC_DIAMETER
               ELSE
                  SM%THERMOPHORETIC_DIAMETER = MEAN_DIAMETER
               ENDIF
               IF (ABS(DENSITY_SOLID-1800._EB) <=TWO_EPSILON_EB .AND. &
                     ABS(DENSITY_SOLID-SPECIES(NS2)%DENSITY_SOLID) <=TWO_EPSILON_EB) THEN
                     SM%DENSITY_SOLID = DENSITY_SOLID
               ELSE
                     SM%DENSITY_SOLID = SPECIES(NS2)%DENSITY_SOLID
               ENDIF
               SM%CONDUCTIVITY_SOLID=SPECIES(NS2)%CONDUCTIVITY_SOLID
            ELSE
               WRITE(MESSAGE,'(A,A,A)') 'WARNING: Cannot do deposition with a lumped species.  Species ',TRIM(SM%ID),&
                                        ' will not have deposition'
               IF (MYID==0) WRITE(LU_ERR,'(A)') TRIM(MESSAGE)
            ENDIF
         ENDIF
         EXIT FIND_SPEC_ID
      ENDIF
   ENDDO FIND_SPEC_ID
   IF (Y_INDEX(NS)<0) THEN
      WRITE(MESSAGE,'(A,A,A,I0,A)') 'ERROR: SPEC ' ,TRIM(SM%ID),', sub species ',NS,' not found.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (MASS_FRACTION(NS)>0._EB)     CONVERSION = CONVERSION + MASS_FRACTION(NS)   / SPECIES(Y_INDEX(NS))%MW
   IF (VOLUME_FRACTION(NS)>0._EB)   CONVERSION = CONVERSION + VOLUME_FRACTION(NS) * SPECIES(Y_INDEX(NS))%MW
   IF (.NOT. PREDEFINED_SMIX(NN) .AND. MASS_FRACTION(NS)<=0._EB .AND. VOLUME_FRACTION(NS)<=0._EB) THEN
      WRITE(MESSAGE,'(A,A,A,I0,A)') 'ERROR: SPEC ' ,TRIM(SM%ID),', mass or volume fraction for sub species ',NS,' not found.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

ENDDO

IF (ANY(MASS_FRACTION>0._EB)) THEN
   DO NS = 1,N_SUB_SPECIES
      SM%VOLUME_FRACTION(Y_INDEX(NS)) = MASS_FRACTION(NS) / SPECIES(Y_INDEX(NS))%MW / CONVERSION
      SM%MASS_FRACTION(Y_INDEX(NS))   = MASS_FRACTION(NS)
   ENDDO
ENDIF

IF (ANY(VOLUME_FRACTION>0._EB)) THEN
   DO NS = 1,N_SUB_SPECIES
      SM%MASS_FRACTION(Y_INDEX(NS))   = VOLUME_FRACTION(NS) * SPECIES(Y_INDEX(NS))%MW / CONVERSION
      SM%VOLUME_FRACTION(Y_INDEX(NS)) = VOLUME_FRACTION(NS)
   ENDDO
ENDIF

! Normalize mass and volume fractions, plus stoichiometric coefficient

SM%MASS_FRACTION = SM%MASS_FRACTION / SUM(SM%MASS_FRACTION)
IF (.NOT. SIMPLE_CHEMISTRY) SM%ADJUST_NU = SUM(SM%VOLUME_FRACTION)
SM%VOLUME_FRACTION = SM%VOLUME_FRACTION / SUM(SM%VOLUME_FRACTION)

! Calculate the molecular weight and extinction coefficient

SM%MW = 0._EB
SM%MASS_EXTINCTION_COEFFICIENT = 0._EB
DO NS = 1,N_SPECIES
   IF (SM%MASS_FRACTION(NS) <TWO_EPSILON_EB) CYCLE
   IF (MASS_EXTINCTION_COEFFICIENT > 0._EB) THEN
      SM%MASS_EXTINCTION_COEFFICIENT = MASS_EXTINCTION_COEFFICIENT
   ELSE
      SM%MASS_EXTINCTION_COEFFICIENT = SM%MASS_EXTINCTION_COEFFICIENT+SM%MASS_FRACTION(NS)*SPECIES(NS)%MASS_EXTINCTION_COEFFICIENT
   ENDIF
   IF (MW > 0._EB) THEN
      SM%MW = MW
   ELSE
      SM%MW = SM%MW + SM%VOLUME_FRACTION(NS) * SPECIES(NS)%MW
   ENDIF
   IF (SPECIES(NS)%FORMULA(1:5)=='SPEC_') SM%VALID_ATOMS = .FALSE.
   IF (FORMULA /= 'null' .AND. .NOT. PREDEFINED_SMIX(NN)) THEN
      CALL GET_FORMULA_WEIGHT(FORMULA,SM%MW,SM%ATOMS)
   ELSE
      SM%ATOMS = SM%ATOMS + SM%VOLUME_FRACTION(NS)*SPECIES(NS)%ATOMS
   ENDIF
ENDDO

SM%RCON = R0/SM%MW

IF (SM%H_F > -1.E23_EB) SM%H_F = SM%H_F/SM%MW*1000._EB !J/mol -> J/kg
IF (SM%SPECIFIC_HEAT > 0._EB) THEN
   IF (SM%H_F > -1.E23_EB) THEN
      SM%REFERENCE_ENTHALPY = SM%H_F - SM%SPECIFIC_HEAT*H_F_REFERENCE_TEMPERATURE
   ELSE
      IF (SM%REFERENCE_ENTHALPY < -1.E20_EB) SM%REFERENCE_ENTHALPY = SM%SPECIFIC_HEAT * SM%REFERENCE_TEMPERATURE
      SM%H_F = SM%REFERENCE_ENTHALPY + SM%SPECIFIC_HEAT * (H_F_REFERENCE_TEMPERATURE - SM%REFERENCE_TEMPERATURE)
   ENDIF
ENDIF

END SUBROUTINE DEFINE_MIXTURE


!> \brief Set default SPECies parameters

SUBROUTINE SET_SPEC_DEFAULT

AEROSOL                     = .FALSE.
BACKGROUND                  = .FALSE.
BETA_LIQUID                 = -1._EB
CONDUCTIVITY                = -1._EB
CONDUCTIVITY_LIQUID         = -1._EB
CONDUCTIVITY_SOLID          = 0.26_EB !W/m/K Ben-Dor, et al. 2002. (~10 x air)
COPY_LUMPED                 = .FALSE.
DENSITY_SOLID               = 1800._EB !kg/m^3 Slowik, et al. 2004
DIFFUSIVITY                 = -1._EB
EPSILONKLJ                  =  0._EB
FIC_CONCENTRATION           =  0._EB
FLD_LETHAL_DOSE             =  0._EB
FORMULA                     = 'null'
FYI                         = 'null'
ENTHALPY_OF_FORMATION       = -1.E30_EB  ! J/mol
ID                          = 'null'
LUMPED_COMPONENT_ONLY       = .FALSE.
RADCAL_ID                   = 'null'
MASS_EXTINCTION_COEFFICIENT = -1._EB  ! m2/kg
MASS_FRACTION               =  0._EB
MASS_FRACTION_0             = -1._EB
MASS_FRACTION_COND_0        = 0._EB
MEAN_DIAMETER               =  -1._EB
THERMOPHORETIC_DIAMETER     =  0.03E-6_EB
MW                          =  0._EB
PR_GAS                      = -1._EB
PRIMITIVE                   = .FALSE.
REFERENCE_TEMPERATURE       = -300._EB ! C
SIGMALJ                     =  0._EB
SPEC_ID                     = 'null'
SPECIFIC_HEAT               = -1._EB
REFERENCE_ENTHALPY          = -2.E20_EB
VISCOSITY                   = -1._EB
VISCOSITY_LIQUID            =  -1._EB
VOLUME_FRACTION             =  0._EB

DENSITY_LIQUID              = -1._EB
HEAT_OF_VAPORIZATION        = -1._EB     ! kJ/kg
H_V_REFERENCE_TEMPERATURE   = -300._EB
MELTING_TEMPERATURE         = -300._EB   ! C
SPECIFIC_HEAT_LIQUID        = -1._EB     ! kJ/kg-K
VAPORIZATION_TEMPERATURE    = -300._EB   ! C

RAMP_CP                     = 'null'
RAMP_CP_L                   = 'null'
RAMP_D                      = 'null'
RAMP_G_F                    = 'null'
RAMP_K                      = 'null'
RAMP_MU                     = 'null'

N_BINS                      = -1
MIN_DIAMETER                = -1._EB !um
MAX_DIAMETER                = -1._EB !um

END SUBROUTINE SET_SPEC_DEFAULT


!> \brief Set up the SMIX line either for the SIMPLE_CHEMISTRY mode or for a primitive species

SUBROUTINE SETUP_PREDEFINED_SMIX(N)

INTEGER, INTENT(IN) :: N
TYPE(REACTION_TYPE), POINTER :: RN

MASS_FRACTION = 0._EB

SELECT CASE(N)
   CASE(1)
      ID               = 'AIR'
      FORMULA          = 'Z0'
      SPEC_ID(1)       = 'WATER VAPOR'
      SPEC_ID(2)       = 'OXYGEN'
      SPEC_ID(3)       = 'CARBON DIOXIDE'
      SPEC_ID(4)       = 'NITROGEN'
      MASS_FRACTION(1) = Y_H2O_INFTY
      MASS_FRACTION(2) = Y_O2_INFTY*(1._EB-Y_H2O_INFTY)
      MASS_FRACTION(3) = Y_CO2_INFTY*(1._EB-Y_H2O_INFTY)
      MASS_FRACTION(4) = 1._EB-SUM(MASS_FRACTION)
   CASE(2)
      RN => REACTION(1)
      ID               = RN%FUEL
      FORMULA          = 'Z1'
      SPEC_ID(1)       = RN%FUEL
      MASS_FRACTION(1) = 1._EB
   CASE(3)
      IF (N_SIMPLE_CHEMISTRY_REACTIONS==1) RN=>REACTION(1)
      IF (N_SIMPLE_CHEMISTRY_REACTIONS==2) RN=>REACTION(2)
      ID                 = 'PRODUCTS'
      FORMULA            = 'Z2'
      SPEC_ID(1)         = 'CARBON MONOXIDE'
      SPEC_ID(2)         = 'SOOT'
      SPEC_ID(3)         = 'WATER VAPOR'
      SPEC_ID(4)         = 'CARBON DIOXIDE'
      SPEC_ID(5)         = 'HYDROGEN CYANIDE'
      SPEC_ID(6)         = 'NITROGEN'
      RN%NU_CO           = (SPECIES_MIXTURE(FUEL_SMIX_INDEX)%MW/MW_CO)     *REACTION(1)%CO_YIELD
      RN%NU_HCN          = (SPECIES_MIXTURE(FUEL_SMIX_INDEX)%MW/MW_HCN)    *REACTION(1)%HCN_YIELD
      RN%NU_SOOT         = (SPECIES_MIXTURE(FUEL_SMIX_INDEX)%MW/RN%MW_SOOT)*REACTION(1)%SOOT_YIELD
      RN%NU_H2O          = 0.5_EB*REACTION(1)%H - 0.5_EB*(RN%NU_SOOT*REACTION(1)%SOOT_H_FRACTION + RN%NU_HCN)
      IF (ABS(RN%NU_H2O) < TWO_EPSILON_EB) RN%NU_H2O = 0._EB
      RN%NU_CO2          = REACTION(1)%C - RN%NU_CO - RN%NU_HCN - RN%NU_SOOT*(1._EB-REACTION(1)%SOOT_H_FRACTION)
      IF (ABS(RN%NU_CO2) < TWO_EPSILON_EB) RN%NU_CO2 = 0._EB
      RN%NU_O2           = RN%NU_CO2 + 0.5_EB*(RN%NU_CO+RN%NU_H2O-REACTION(1)%O)
      RN%NU_N2           = 0.5_EB*(REACTION(1)%N - RN%NU_HCN)
      IF (RN%NU_CO2 <0._EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: REAC, Not enough carbon in the fuel for the specified CO_YIELD, SOOT_YIELD, and/or HCN_YIELD'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (RN%NU_H2O <0._EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: REAC, Not enough hydrogen in the fuel for the specified SOOT_YIELD and/or HCN_YIELD'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (RN%NU_N2 <0._EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: REAC, Not enough nitrogen in the fuel for the specified HCN_YIELD'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      VOLUME_FRACTION(1) = RN%NU_CO
      VOLUME_FRACTION(2) = RN%NU_SOOT
      VOLUME_FRACTION(3) = RN%NU_H2O + SPECIES_MIXTURE(1)%VOLUME_FRACTION(H2O_INDEX)*RN%NU_O2 / &
                                       SPECIES_MIXTURE(1)%VOLUME_FRACTION(O2_INDEX)
      VOLUME_FRACTION(4) = RN%NU_CO2 + SPECIES_MIXTURE(1)%VOLUME_FRACTION(CO2_INDEX)*RN%NU_O2 / &
                                       SPECIES_MIXTURE(1)%VOLUME_FRACTION(O2_INDEX)
      VOLUME_FRACTION(5) = RN%NU_HCN
      VOLUME_FRACTION(6) = RN%NU_N2  + SPECIES_MIXTURE(1)%VOLUME_FRACTION(N2_INDEX)*RN%NU_O2 / &
                                       SPECIES_MIXTURE(1)%VOLUME_FRACTION(O2_INDEX)
      VOLUME_FRACTION    = VOLUME_FRACTION/SUM(VOLUME_FRACTION)
      SPECIES(SOOT_INDEX)%ATOMS=0._EB
      SPECIES(SOOT_INDEX)%ATOMS(1)=REACTION(1)%SOOT_H_FRACTION
      SPECIES(SOOT_INDEX)%ATOMS(6)=1._EB-REACTION(1)%SOOT_H_FRACTION
   CASE(4)
      RN => REACTION(1)
      ID                 = 'INTERMEDIATE PRODUCTS'
      FORMULA            = 'Z3'
      SPEC_ID(1)         = 'CARBON MONOXIDE'
      SPEC_ID(2)         = 'SOOT'
      SPEC_ID(3)         = 'WATER VAPOR'
      SPEC_ID(4)         = 'CARBON DIOXIDE'
      SPEC_ID(5)         = 'HYDROGEN CYANIDE'
      SPEC_ID(6)         = 'NITROGEN'
      SPEC_ID(7)         = 'HYDROGEN'
      RN%NU_HCN          = REACTION(1)%N*FUEL_N_TO_HCN_FRACTION
      RN%NU_CO           = REACTION(1)%C*FUEL_C_TO_CO_FRACTION
      IF (ABS(RN%NU_CO)<TWO_EPSILON_EB) RN%NU_CO = 0._EB
      RN%NU_SOOT         = (REACTION(1)%C-RN%NU_CO-RN%NU_HCN)/(1._EB-REACTION(1)%SOOT_H_FRACTION)
      IF (ABS(RN%NU_SOOT)<TWO_EPSILON_EB) RN%NU_SOOT = 0._EB
      RN%NU_H2           = REACTION(1)%H*FUEL_H_TO_H2_FRACTION*0.5_EB
      IF (ABS(RN%NU_H2)<TWO_EPSILON_EB) RN%NU_H2 = 0._EB
      RN%NU_H2O          = 0.5_EB*(REACTION(1)%H - 0.5_EB*RN%NU_H2 - RN%NU_HCN - RN%NU_SOOT*REACTION(1)%SOOT_H_FRACTION)
      IF (ABS(RN%NU_H2O)<TWO_EPSILON_EB) RN%NU_H2O = 0._EB
      RN%NU_CO2          = REACTION(1)%C - RN%NU_CO - RN%NU_SOOT*(1._EB-REACTION(1)%SOOT_H_FRACTION) - RN%NU_HCN
      IF (ABS(RN%NU_CO2)<TWO_EPSILON_EB) RN%NU_CO2 = 0._EB
      RN%NU_O2           = RN%NU_CO2 + 0.5_EB*(RN%NU_CO+RN%NU_H2O-REACTION(1)%O)
      RN%NU_N2           = (REACTION(1)%N-RN%NU_HCN)*0.5_EB
      IF (ABS(RN%NU_N2)<TWO_EPSILON_EB) RN%NU_N2 = 0._EB

      IF (RN%NU_N2 <0._EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: REAC, Not enough nitrogen in the fuel for the specified FUEL_N_TO_HCN_FRACTION'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (RN%NU_CO2 <0._EB) THEN
         WRITE(MESSAGE,'(A)') &
            'ERROR: REAC, Not enough carbon in the fuel for the specified FUEL_C_TO_CO_FRACTION and/or FUEL_N_TO_HCN_FRACTION'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (RN%NU_H2O <0._EB) THEN
         WRITE(MESSAGE,'(A)') &
            'ERROR: REAC, Not enough hydrogen in the fuel for the specified FUEL_H_TO_H2_FRACTION and/or FUEL_N_TO_HCN_FRACTION'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      VOLUME_FRACTION(1) = RN%NU_CO
      VOLUME_FRACTION(2) = RN%NU_SOOT
      VOLUME_FRACTION(3) = RN%NU_H2O + SPECIES_MIXTURE(1)%VOLUME_FRACTION(H2O_INDEX)*RN%NU_O2 / &
                                       SPECIES_MIXTURE(1)%VOLUME_FRACTION(O2_INDEX)
      VOLUME_FRACTION(4) = RN%NU_CO2 + SPECIES_MIXTURE(1)%VOLUME_FRACTION(CO2_INDEX)*RN%NU_O2 / &
                                       SPECIES_MIXTURE(1)%VOLUME_FRACTION(O2_INDEX)
      VOLUME_FRACTION(5) = RN%NU_HCN
      VOLUME_FRACTION(6) = RN%NU_N2  + SPECIES_MIXTURE(1)%VOLUME_FRACTION(N2_INDEX)*RN%NU_O2 / &
                                       SPECIES_MIXTURE(1)%VOLUME_FRACTION(O2_INDEX)
      VOLUME_FRACTION(7) = RN%NU_H2
      VOLUME_FRACTION    = VOLUME_FRACTION/SUM(VOLUME_FRACTION)
      SPECIES(SOOT_INDEX)%ATOMS=0._EB
      SPECIES(SOOT_INDEX)%ATOMS(1)=REACTION(1)%SOOT_H_FRACTION
      SPECIES(SOOT_INDEX)%ATOMS(6)=1._EB-REACTION(1)%SOOT_H_FRACTION
END SELECT

END SUBROUTINE SETUP_PREDEFINED_SMIX

LOGICAL FUNCTION CHECK_CONDENSABLE(SS_TMP_V,SS2_ID)
USE PROPERTY_DATA, ONLY: JANAF_TABLE_LIQUID
REAL(EB), INTENT(IN):: SS_TMP_V
CHARACTER(LABEL_LENGTH), INTENT(IN) :: SS2_ID
REAL(EB):: C_P_L,H_V,H_L,TMP_REF,TMP_MELT,TMP_V,DENSITY,MU_LIQUID,K_LIQUID,BETA_LIQUID
LOGICAL:: FUEL2

CALL JANAF_TABLE_LIQUID (1,C_P_L,H_V,H_L,TMP_REF,TMP_MELT,TMP_V,SS2_ID,FUEL2,DENSITY,MU_LIQUID,K_LIQUID,BETA_LIQUID)

CHECK_CONDENSABLE = .FALSE.
IF (SS_TMP_V > 0._EB .OR. TMP_V > 0._EB) CHECK_CONDENSABLE = .TRUE.

END FUNCTION CHECK_CONDENSABLE

END SUBROUTINE READ_SPEC


!> \brief Create the Z to Y transformation matrix and fill up the gas property tables

SUBROUTINE PROC_SMIX

USE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP
USE PROPERTY_DATA, ONLY: JANAF_TABLE, CALC_GAS_PROPS, GAS_PROPS, CALC_MIX_PROPS
REAL(EB), ALLOCATABLE, DIMENSION(:) :: MU_TMP,CP_TMP,K_TMP,H_TMP,D_TMP,G_F_TMP, &
                                       MU_TMP_Z,CP_TMP_Z,K_TMP_Z,H_TMP_Z,D_TMP_Z,G_F_TMP_Z,RSQ_MW_Y
REAL(EB) :: CP1,CP2,H1,H2,H_REF_SENSIBLE(1:N_TRACKED_SPECIES),REF_TEMP
INTEGER :: N
TYPE(SPECIES_TYPE), POINTER :: SS=>NULL()
TYPE(SPECIES_MIXTURE_TYPE), POINTER :: SM=>NULL()

! Set up RSQ Arrays

ALLOCATE(RSQ_MW_Z(N_TRACKED_SPECIES),STAT=IZERO)
CALL ChkMemErr('READ','RSQ_MW_Z',IZERO)

RSQ_MW_Z = 1._EB/SQRT(SPECIES_MIXTURE%MW)

ALLOCATE(RSQ_MW_Y(N_SPECIES),STAT=IZERO)
CALL ChkMemErr('READ','RSQ_MW_Y',IZERO)

RSQ_MW_Y=1._EB/SQRT(SPECIES%MW)

! Compute gas properties for primitive species 1 to N_SPECIES.

ALLOCATE(D_TMP(N_SPECIES))
D_TMP = 0._EB
ALLOCATE(MU_TMP(N_SPECIES))
MU_TMP = 0._EB
ALLOCATE(CP_TMP(N_SPECIES))
CP_TMP = 0._EB
ALLOCATE(H_TMP(N_SPECIES))
H_TMP = 0._EB
ALLOCATE(K_TMP(N_SPECIES))
K_TMP = 0._EB
ALLOCATE(G_F_TMP(N_SPECIES))
G_F_TMP = 0._EB

ALLOCATE(D_TMP_Z(N_TOTAL_SCALARS))
D_TMP_Z = -1.E30_EB
ALLOCATE(MU_TMP_Z(N_TOTAL_SCALARS))
MU_TMP_Z = -1.E30_EB
ALLOCATE(CP_TMP_Z(N_TOTAL_SCALARS))
CP_TMP_Z = -1.E30_EB
ALLOCATE(H_TMP_Z(N_TOTAL_SCALARS))
H_TMP_Z = -1.E30_EB
ALLOCATE(K_TMP_Z(N_TOTAL_SCALARS))
K_TMP_Z = -1.E30_EB
ALLOCATE(G_F_TMP_Z(N_TOTAL_SCALARS))
G_F_TMP_Z = -1.E30_EB

ALLOCATE(CPBAR_Z(0:5000,N_TOTAL_SCALARS))
CALL ChkMemErr('READ','CPBAR_Z',IZERO)
CPBAR_Z = 0._EB

!ALLOCATE(CP_AVG_Z(0:5000,N_TOTAL_SCALARS))
!CALL ChkMemErr('READ','CP_AVG_Z',IZERO)
!CP_AVG_Z = 0._EB

ALLOCATE(H_SENS_Z(0:5000,N_TOTAL_SCALARS))
CALL ChkMemErr('READ','H_SENS_Z',IZERO)
H_SENS_Z = 0._EB

ALLOCATE(K_RSQMW_Z(0:5000,N_TOTAL_SCALARS))
CALL ChkMemErr('READ','K_RSQMW_Z',IZERO)
K_RSQMW_Z = 0._EB

ALLOCATE(MU_RSQMW_Z(0:5000,N_TOTAL_SCALARS))
CALL ChkMemErr('READ','MU_RSQMW_Z',IZERO)
MU_RSQMW_Z = 0._EB

ALLOCATE(CP_Z(0:5000,N_TOTAL_SCALARS))
CALL ChkMemErr('READ','CP_Z',IZERO)
CP_Z = 0._EB

ALLOCATE(D_Z(0:5000,N_TOTAL_SCALARS))
CALL ChkMemErr('READ','D_Z',IZERO)
D_Z = 0._EB

ALLOCATE(G_F_Z(0:5000,N_TOTAL_SCALARS))
CALL ChkMemErr('READ','G_F_Z',IZERO)
G_F_Z = 0._EB

! Adjust reference enthalpy to 0 K if a RAMP_CP is given
DO N=1,N_SPECIES
   SS => SPECIES(N)
   IF(SS%RAMP_CP_INDEX > 0) THEN
      IF (SS%H_F > -1.E20_EB) THEN
         CP2 = EVALUATE_RAMP(1._EB,1._EB,SS%RAMP_CP_INDEX)*1000._EB
         H2 = 0._EB
         DO J=1,INT(H_F_REFERENCE_TEMPERATURE)+1
            H1 = H2
            CP1 = CP2
            CP2 = EVALUATE_RAMP(REAL(J,EB),1._EB,SS%RAMP_CP_INDEX)*1000._EB
            H2 = H2 + 0.5_EB*(CP1+CP2)
         ENDDO
         SS%REFERENCE_ENTHALPY = SS%H_F/SS%MW*1000._EB - &
                                 (H1 + (H2-H1)*(H_F_REFERENCE_TEMPERATURE-INT(H_F_REFERENCE_TEMPERATURE)))
      ELSE
         IF (SS%REFERENCE_TEMPERATURE<=TWO_EPSILON_EB) CYCLE
         CP2 = EVALUATE_RAMP(1._EB,1._EB,SS%RAMP_CP_INDEX)*1000._EB
         H2 = 0._EB
         DO J=1,INT(SS%REFERENCE_TEMPERATURE)+1
            H1 = H2
            CP1 = CP2
            CP2 = EVALUATE_RAMP(REAL(J,EB),1._EB,SS%RAMP_CP_INDEX)*1000._EB
            H2 = H2 + 0.5_EB*(CP1+CP2)
         ENDDO
         SS%REFERENCE_ENTHALPY = SS%REFERENCE_ENTHALPY - &
                                 (H1 + (H2-H1)*(SS%REFERENCE_TEMPERATURE-INT(SS%REFERENCE_TEMPERATURE)))
         IF (SS%H_F <= -1.E20) THEN
            CP2 = EVALUATE_RAMP(1._EB,1._EB,SS%RAMP_CP_INDEX)*1000._EB
            H2 = SS%REFERENCE_ENTHALPY
            DO J=1,INT(H_F_REFERENCE_TEMPERATURE)+1
               H1 = H2
               CP1 = CP2
               CP2 = EVALUATE_RAMP(REAL(J,EB),1._EB,SS%RAMP_CP_INDEX)*1000._EB
               H2 = H2 + 0.5_EB*(CP1+CP2)
            ENDDO
            SS%H_F = (H1 + (H2-H1)*(H_F_REFERENCE_TEMPERATURE-INT(H_F_REFERENCE_TEMPERATURE)))*SS%MW*0.001_EB
         ENDIF
      ENDIF
   ENDIF
END DO

DO N=1,N_TRACKED_SPECIES
   SM => SPECIES_MIXTURE(N)
   IF(SM%RAMP_CP_INDEX > 0) THEN
      IF (SM%H_F > -1.E20_EB) THEN
         CP2 = EVALUATE_RAMP(1._EB,1._EB,SM%RAMP_CP_INDEX)*1000._EB
         H2 = 0._EB
         DO J=1,INT(H_F_REFERENCE_TEMPERATURE)+1
            H1 = H2
            CP1 = CP2
            CP2 = EVALUATE_RAMP(REAL(J,EB),1._EB,SM%RAMP_CP_INDEX)*1000._EB
            H2 = H2 + 0.5_EB*(CP1+CP2)
         ENDDO
         SM%REFERENCE_ENTHALPY = SM%H_F - &
                                 (H1 + (H2-H1)*(H_F_REFERENCE_TEMPERATURE-INT(H_F_REFERENCE_TEMPERATURE)))
      ELSE
         IF (SM%REFERENCE_TEMPERATURE<=TWO_EPSILON_EB) CYCLE
         CP2 = EVALUATE_RAMP(1._EB,1._EB,SM%RAMP_CP_INDEX)*1000._EB
         H2 = 0._EB
         DO J=1,INT(SM%REFERENCE_TEMPERATURE)+1
            H1 = H2
            CP1 = CP2
            CP2 = EVALUATE_RAMP(REAL(J,EB),1._EB,SM%RAMP_CP_INDEX)*1000._EB
            H2 = H2 + 0.5_EB*(CP1+CP2)
         ENDDO
         SM%REFERENCE_ENTHALPY = SM%REFERENCE_ENTHALPY - &
                                 (H1 + (H2-H1)*(SM%REFERENCE_TEMPERATURE-INT(SM%REFERENCE_TEMPERATURE)))
         IF (SM%H_F <= -1.E20) THEN
            CP2 = EVALUATE_RAMP(1._EB,1._EB,SM%RAMP_CP_INDEX)*1000._EB
            H2 = SM%REFERENCE_ENTHALPY
            DO J=1,INT(H_F_REFERENCE_TEMPERATURE)+1
               H1 = H2
               CP1 = CP2
               CP2 = EVALUATE_RAMP(REAL(J,EB),1._EB,SM%RAMP_CP_INDEX)*1000._EB
               H2 = H2 + 0.5_EB*(CP1+CP2)
            ENDDO
            SM%H_F = H1 + (H2-H1)*(H_F_REFERENCE_TEMPERATURE-INT(H_F_REFERENCE_TEMPERATURE))
         ENDIF
      ENDIF
   ENDIF
   IF(SM%H_F <= -1.E20_EB) THEN
      SM%H_F = 0._EB
      DO J=1,N_SPECIES
         SM%H_F = SM%H_F + SM%VOLUME_FRACTION(J) * SPECIES(J)%H_F ! Calculate H_F of mixtures
      ENDDO
      SM%H_F = SM%H_F/SM%MW*1000._EB
   ENDIF
END DO

! Loop through temperatures from 1 K to 5000 K to get temperature-specific gas properties.  Data from JANAF 4

TABLE_LOOP: DO J=1,5000

   ! For each primitive species, get its property values at temperature J

   DO N=1,N_SPECIES
      SS => SPECIES(N)
      CALL CALC_GAS_PROPS(J,N,D_TMP(N),MU_TMP(N),K_TMP(N),CP_TMP(N),H_TMP(N),SS%ISFUEL,G_F_TMP(N))
      IF (SS%RAMP_CP_INDEX>0) THEN
         CP_TMP(N) = EVALUATE_RAMP(REAL(J,EB),0._EB,SS%RAMP_CP_INDEX)*1000._EB
         H_TMP(N) = SS%REFERENCE_ENTHALPY
      ENDIF
      IF (SS%RAMP_D_INDEX>0)   D_TMP(N)   = EVALUATE_RAMP(REAL(J,EB),1._EB,SS%RAMP_D_INDEX)
      IF (SS%RAMP_G_F_INDEX>0) G_F_TMP(N) = EVALUATE_RAMP(REAL(J,EB),1._EB,SS%RAMP_G_F_INDEX)
      IF (SS%RAMP_K_INDEX>0)   K_TMP(N)   = EVALUATE_RAMP(REAL(J,EB),1._EB,SS%RAMP_K_INDEX)/SQRT(SS%MW)
      IF (SS%RAMP_MU_INDEX>0)  MU_TMP(N)  = EVALUATE_RAMP(REAL(J,EB),1._EB,SS%RAMP_MU_INDEX)/SQRT(SS%MW)
   ENDDO

   DO N=1,N_TRACKED_SPECIES
      SM => SPECIES_MIXTURE(N)
      CALL CALC_MIX_PROPS(J,D_TMP_Z(N),MU_TMP_Z(N),K_TMP_Z(N),CP_TMP_Z(N),H_TMP_Z(N),SM%EPSK,SM%SIG,SM%D_USER,&
                          SM%MU_USER,SM%K_USER,SM%MW,SM%SPECIFIC_HEAT,SM%REFERENCE_ENTHALPY,SM%REFERENCE_TEMPERATURE,SM%PR_USER)
      IF (SM%RAMP_CP_INDEX>0) THEN
         CP_TMP_Z(N) = EVALUATE_RAMP(REAL(J,EB),0._EB,SM%RAMP_CP_INDEX)*1000._EB
         H_TMP_Z(N) = SM%REFERENCE_ENTHALPY
      ENDIF
      IF (SM%RAMP_D_INDEX>0)   D_TMP_Z(N)   = EVALUATE_RAMP(REAL(J,EB),1._EB,SM%RAMP_D_INDEX)
      IF (SM%RAMP_G_F_INDEX>0) G_F_TMP_Z(N) = EVALUATE_RAMP(REAL(J,EB),1._EB,SM%RAMP_G_F_INDEX)
      IF (SM%RAMP_K_INDEX>0)   K_TMP_Z(N)   = EVALUATE_RAMP(REAL(J,EB),1._EB,SM%RAMP_K_INDEX)*RSQ_MW_Z(N)
      IF (SM%RAMP_MU_INDEX>0)  MU_TMP_Z(N)  = EVALUATE_RAMP(REAL(J,EB),1._EB,SM%RAMP_MU_INDEX)*RSQ_MW_Z(N)
   ENDDO

   ! For each tracked species, store the mass-weighted property values

   SPECIES_LOOP: DO N=1,N_TRACKED_SPECIES
      IF (SPECIES_MIXTURE(N)%REFERENCE_ENTHALPY < -1.E20_EB) SPECIES_MIXTURE(N)%REFERENCE_ENTHALPY = SUM(Z2Y(:,N) * H_TMP(:))
      IF (D_TMP_Z(N) > 0._EB) THEN
         D_Z(J,N) = D_TMP_Z(N)
      ELSE
         D_Z(J,N) = SPECIES_MIXTURE(N)%MW*SUM(Z2Y(:,N)*D_TMP(:)/SPECIES(:)%MW)
      ENDIF
      IF (CP_TMP_Z(N) > 0._EB) THEN
         CP_Z(J,N) = CP_TMP_Z(N)
         IF (J==1) CP_Z(0,N) = CP_Z(1,N)
         H_SENS_Z(J,N) = H_SENS_Z(J-1,N) + 0.5_EB*(CP_Z(J,N)+CP_Z(J-1,N))
         IF (J>1) THEN
            CPBAR_Z(J,N) = (CPBAR_Z(J-1,N)*REAL(J-1,EB)+0.5_EB*(CP_Z(J,N)+CP_Z(J-1,N)))/REAL(J,EB)
         ELSE
            CPBAR_Z(0,N) = H_TMP_Z(N)
            CPBAR_Z(J,N) = CPBAR_Z(0,N) + CP_Z(J,N)
         ENDIF
      ELSE
         CP_Z(J,N) = SUM(Z2Y(:,N) * CP_TMP(:))
         IF (J==1) CP_Z(0,N) = CP_Z(1,N)
         H_SENS_Z(J,N) = H_SENS_Z(J-1,N) + 0.5_EB*(CP_Z(J,N)+CP_Z(J-1,N))
         IF (J>1) THEN
            CPBAR_Z(J,N) = (CPBAR_Z(J-1,N)*REAL(J-1,EB)+0.5_EB*(CP_Z(J,N)+CP_Z(J-1,N)))/REAL(J,EB)
         ELSE
            CPBAR_Z(0,N) = SUM(Z2Y(:,N) * H_TMP(:))
            CPBAR_Z(J,N) = CPBAR_Z(0,N) + CP_Z(J,N)
         ENDIF
      ENDIF
      IF (MU_TMP_Z(N) > 0._EB) THEN
         MU_RSQMW_Z(J,N) = MU_TMP_Z(N)
      ELSE
         MU_RSQMW_Z(J,N) = SUM(Z2Y(:,N) * MU_TMP(:)) / SUM(Z2Y(:,N) * RSQ_MW_Y(:)) * RSQ_MW_Z(N)
      ENDIF
      IF (K_TMP_Z(N) > 0._EB) THEN
         K_RSQMW_Z(J,N)  = K_TMP_Z(N)
      ELSE
         K_RSQMW_Z(J,N)  = SUM(Z2Y(:,N) * K_TMP(:)) / SUM(Z2Y(:,N) * RSQ_MW_Y(:)) * RSQ_MW_Z(N)
      ENDIF
      IF (G_F_TMP_Z(N) > 0._EB) THEN
         G_F_Z(J,N) = G_F_TMP_Z(N)
      ELSE
         G_F_Z(J,N) = SUM(Z2Y(:,N) * G_F_TMP(:))
      ENDIF
   ENDDO SPECIES_LOOP
ENDDO TABLE_LOOP

D_Z(0,:) = D_Z(1,:)
MU_RSQMW_Z(0,:) = MU_RSQMW_Z(1,:)
K_RSQMW_Z(0,:) = K_RSQMW_Z(1,:)

! Adjust H_SENS_Z to 0 at the H_F_REFERENCE_TEMPERATURE
IF (CONSTANT_SPECIFIC_HEAT_RATIO) THEN
   REF_TEMP = 0._EB
ELSE
   REF_TEMP = H_F_REFERENCE_TEMPERATURE
ENDIF
J = INT(REF_TEMP)
H_REF_SENSIBLE(:) = H_SENS_Z(J,:)+(REF_TEMP-REAL(J,EB))*(H_SENS_Z(J+1,:)-H_SENS_Z(J,:))
H_SENS_Z(0,:) = -H_REF_SENSIBLE(:)
DO J = 1, 5000
   H_SENS_Z(J,:) = H_SENS_Z(J,:)-H_REF_SENSIBLE(:)
!   CP_AVG_Z(J,:) = H_SENS_Z(J,:)/REAL(J,EB)
ENDDO

DO N=1,N_TRACKED_SPECIES
   SM=>SPECIES_MIXTURE(N)
   IF (SM%H_F <=-1.E20_EB) THEN
      H1=CPBAR_Z(INT(H_F_REFERENCE_TEMPERATURE),N)*REAL(INT(H_F_REFERENCE_TEMPERATURE),EB)
      H2=CPBAR_Z(INT(H_F_REFERENCE_TEMPERATURE)+1,N)*REAL(INT(H_F_REFERENCE_TEMPERATURE)+1,EB)
      SM%H_F = H1+(H2-H1)*(H_F_REFERENCE_TEMPERATURE-REAL(INT(H_F_REFERENCE_TEMPERATURE),EB))
   ENDIF
END DO

DEALLOCATE(RSQ_MW_Y)

DEALLOCATE(D_TMP)
DEALLOCATE(MU_TMP)
DEALLOCATE(CP_TMP)
DEALLOCATE(H_TMP)
DEALLOCATE(K_TMP)
DEALLOCATE(G_F_TMP)

DEALLOCATE(D_TMP_Z)
DEALLOCATE(MU_TMP_Z)
DEALLOCATE(CP_TMP_Z)
DEALLOCATE(H_TMP_Z)
DEALLOCATE(K_TMP_Z)

END SUBROUTINE PROC_SMIX


!> \brief Process SPECies input data

SUBROUTINE PROC_SPEC

USE PROPERTY_DATA, ONLY: JANAF_TABLE_LIQUID
USE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP
USE RADCONS, ONLY : MIE_NDG
INTEGER :: N,J,ITMP,I_MELT,I_BOIL, IZERO
LOGICAL :: FUEL
REAL(EB) :: H_L,H_V,CPBAR,H_G_S,H_G_S_REF,H_L_REF,TMP_REF,TMP_MELT,TMP_V,TMP_WGT,DENSITY,MU_LIQUID,K_LIQUID,BETA_LIQUID
TYPE(SPECIES_TYPE),POINTER:: SS=>NULL()
TYPE(SPECIES_MIXTURE_TYPE),POINTER:: SM=>NULL()

SPEC_LOOP: DO N=1,N_TRACKED_SPECIES
   IF (.NOT. SPECIES_MIXTURE(N)%EVAPORATION_SMIX_INDEX > 0) CYCLE SPEC_LOOP
   SM => SPECIES_MIXTURE(N)
   SS => SPECIES(SPECIES_MIXTURE(N)%SINGLE_SPEC_INDEX)
   IF (SS%TMP_V > 0._EB) CYCLE SPEC_LOOP

   IZERO = 0
   IF (.NOT.ALLOCATED(SS%C_P_L)) ALLOCATE(SS%C_P_L(0:5000),STAT=IZERO)
   CALL ChkMemErr('PROC_SPEC','SS%C_P_L',IZERO)
   SS%C_P_L=SS%SPECIFIC_HEAT_LIQUID
   IF (.NOT.ALLOCATED(SS%C_P_L_BAR)) ALLOCATE(SS%C_P_L_BAR(0:5000),STAT=IZERO)
   CALL ChkMemErr('PROC_SPEC','SS%C_P_L_BAR',IZERO)
   IF (.NOT.ALLOCATED(SS%H_L)) ALLOCATE(SS%H_L(0:5000),STAT=IZERO)
   CALL ChkMemErr('PROC_SPEC','SS%H_L',IZERO)
   IF (.NOT.ALLOCATED(SS%H_V)) ALLOCATE(SS%H_V(0:5000),STAT=IZERO)
   CALL ChkMemErr('PROC_SPEC','SS%H_V',IZERO)

   TMP_REF = -1._EB
   TMP_MELT = -1._EB
   TMP_V = -1._EB
   TMP_LOOP: DO J = 1, 5000
      IF (SS%C_P_L(J) > 0._EB) THEN
         SS%H_L(J) = (REAL(J,EB)-SS%TMP_MELT)*SS%C_P_L(J)
         IF (J==1) THEN
            CALL JANAF_TABLE_LIQUID (J,CPBAR,H_V,H_L,TMP_REF,TMP_MELT,TMP_V,SS%PROP_ID,FUEL,DENSITY,&
                                       MU_LIQUID,K_LIQUID,BETA_LIQUID)
            IF (SS%H_V_REFERENCE_TEMPERATURE < 0._EB) SS%H_V_REFERENCE_TEMPERATURE=TMP_REF
            IF (SS%TMP_V < 0._EB) SS%TMP_V = TMP_V
            IF (SS%TMP_V < 0._EB) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(SS%ID),' requires a VAPORIZATION_TEMPERATURE'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (SS%TMP_MELT < 0._EB) SS%TMP_MELT = TMP_MELT
            IF (SS%TMP_MELT < 0._EB) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(SS%ID),' requires a TMP_MELT'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (SS%DENSITY_LIQUID < 0._EB) SS%DENSITY_LIQUID = DENSITY
            IF (SS%DENSITY_LIQUID < 0._EB) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(SS%ID),' requires a DENSITY_LIQUID'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDIF
      ELSE
         CALL JANAF_TABLE_LIQUID (J,SS%C_P_L(J),H_V,H_L,TMP_REF,TMP_MELT,TMP_V,SS%ID,FUEL,DENSITY,&
                                    MU_LIQUID,K_LIQUID,BETA_LIQUID)
         IF (SS%RAMP_CP_L_INDEX>0) SS%C_P_L(J) = EVALUATE_RAMP(REAL(J,EB),1._EB,SS%RAMP_CP_L_INDEX)*1000._EB
         IF (J==1) THEN
            IF (SS%H_V_REFERENCE_TEMPERATURE < 0._EB) SS%H_V_REFERENCE_TEMPERATURE=TMP_REF
            IF (SS%TMP_V < 0._EB) SS%TMP_V = TMP_V
            IF (SS%TMP_V < 0._EB) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(SS%ID),' requires a TMP_V'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (SS%TMP_MELT < 0._EB) SS%TMP_MELT = TMP_MELT
            IF (SS%TMP_MELT < 0._EB) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(SS%ID),' requires a TMP_MELT'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (SS%DENSITY_LIQUID < 0._EB) SS%DENSITY_LIQUID = DENSITY
            IF (SS%DENSITY_LIQUID < 0._EB) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(SS%ID),' requires a DENSITY_LIQUID'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (SS%C_P_L(J) < 0._EB) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(SS%ID),' requires SPECIFIC_HEAT_LIQUID or RAMP_CP_L'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            SS%H_L(J) = H_L + SS%C_P_L(J)
         ELSE
            SS%H_L(J) = SS%H_L(J-1) + 0.5_EB*(SS%C_P_L(J)+SS%C_P_L(J-1))
         ENDIF
      ENDIF
   ENDDO TMP_LOOP

   SS%C_P_L(0) = SS%C_P_L(1)
   SS%H_L(0) = SS%H_L(1) - SS%C_P_L(1)


   ! Adjust liquid H_L to force H_V at H_V_REFERENCE_TEMPERATURE

   IF(SS%HEAT_OF_VAPORIZATION > 0._EB) H_V = SS%HEAT_OF_VAPORIZATION
   ITMP = INT(SS%H_V_REFERENCE_TEMPERATURE)
   TMP_WGT  = SS%H_V_REFERENCE_TEMPERATURE - REAL(ITMP,EB)
   H_L_REF = SS%H_L(ITMP)+TMP_WGT*(SS%H_L(ITMP+1)-SS%H_L(ITMP))
   H_G_S_REF=(CPBAR_Z(ITMP,N)+TMP_WGT*(CPBAR_Z(ITMP+1,N)-CPBAR_Z(ITMP,N)))*&
            SS%H_V_REFERENCE_TEMPERATURE
   SS%H_L = SS%H_L + (H_G_S_REF - H_L_REF) - H_V
   I_MELT = INT(SS%TMP_MELT) - 1
   I_BOIL = INT(SS%TMP_V) + 1

   DO J=1,5000
      H_G_S = CPBAR_Z(J,N)*REAL(J,EB)
      SS%H_V(J) = H_G_S - SS%H_L(J)
      IF (SS%H_V(J) < 0._EB .AND. J > I_MELT .AND. J < I_BOIL) THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: PARTicle class ',TRIM(SS%ID), ' H_V(T) < 0.  Check inputs for C_P gas and C_P liquid'
            CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (J==1) THEN
         SS%C_P_L_BAR(J) =  SS%H_L(J)
      ELSE
         SS%C_P_L_BAR(J) = SS%H_L(J) / REAL(J,EB)
      ENDIF
   ENDDO

   SS%H_V(0) = SS%H_V(1)
   SS%C_P_L_BAR(0) = SS%H_L(1)
   TMPMIN = MIN(TMPMIN,SS%TMP_MELT)

   SS%PR_LIQUID = SS%MU_LIQUID*SS%C_P_L(NINT(TMPA))/SS%K_LIQUID

   SS%DENSITY_SOLID = SS%DENSITY_LIQUID
   SS%CONDUCTIVITY_SOLID = SS%K_LIQUID

   CPBAR_Z(:,N) = SS%C_P_L_BAR
   CP_Z(:,N) = SS%C_P_L
   ITMP = INT(H_F_REFERENCE_TEMPERATURE)
   SM%H_F = SS%H_L(ITMP) + (H_F_REFERENCE_TEMPERATURE-REAL(ITMP,EB))*(SS%H_L(ITMP+1)-SS%H_L(ITMP))

   ! Allocate MIE arrays for condensed phase
   ALLOCATE(SM%WQABS(0:MIE_NDG,1:NUMBER_SPECTRAL_BANDS))
   CALL ChkMemErr('INIT','WQABS',IZERO)
   SM%WQABS = 0._EB
   ALLOCATE(SM%WQSCA(0:MIE_NDG,1:NUMBER_SPECTRAL_BANDS))
   CALL ChkMemErr('INIT','WQSCA',IZERO)
   SM%WQSCA = 0._EB
   ALLOCATE(SM%R50(0:MIE_NDG))
   CALL ChkMemErr('INIT','R50',IZERO)
   SM%R50 = 0._EB

END DO SPEC_LOOP

END SUBROUTINE PROC_SPEC


!> \brief Read the COMBustion namelist line

SUBROUTINE READ_COMB

NAMELIST /COMB/ AIT_EXCLUSION_ZONE,AUTO_IGNITION_TEMPERATURE,CHECK_REALIZABILITY,EXTINCTION_MODEL,&
                FLAME_INDEX_MODEL,FIXED_MIX_TIME,FREE_BURN_TEMPERATURE,FUEL_C_TO_CO_FRACTION,FUEL_H_TO_H2_FRACTION,&
                FUEL_N_TO_HCN_FRACTION,&
                INITIAL_UNMIXED_FRACTION,MAX_CHEMISTRY_SUBSTEPS,N_FIXED_CHEMISTRY_SUBSTEPS,N_SIMPLE_CHEMISTRY_REACTIONS,&
                ODE_SOLVER,RADIATIVE_FRACTION,RICHARDSON_ERROR_TOLERANCE,SUPPRESSION,TAU_CHEM,TAU_FLAME

ODE_SOLVER         = 'null'
RADIATIVE_FRACTION = -1._EB

! Read the COMB line

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COMB_LOOP: DO
   CALL CHECKREAD('COMB',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COMB_LOOP
   READ(LU_INPUT,COMB,END=23,ERR=24,IOSTAT=IOS)
   24 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with COMB line') ; RETURN
; ENDIF
ENDDO COMB_LOOP
23 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! Extinction Model

IF (TRIM(EXTINCTION_MODEL)/='null') THEN
   SELECT CASE (TRIM(EXTINCTION_MODEL))
      CASE ('EXTINCTION 1')
         EXTINCT_MOD = EXTINCTION_1
      CASE ('EXTINCTION 2')
         EXTINCT_MOD = EXTINCTION_2
      CASE DEFAULT
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: EXTINCTION_MODEL, ',TRIM(EXTINCTION_MODEL),', is not recognized.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   END SELECT
ELSE
   IF (CONSTANT_SPECIFIC_HEAT_RATIO) THEN
      EXTINCT_MOD = EXTINCTION_1
      EXTINCTION_MODEL = 'EXTINCTION 1'
   ELSE
      EXTINCT_MOD = EXTINCTION_2
      EXTINCTION_MODEL = 'EXTINCTION 2'
   ENDIF
ENDIF

! Check range of INITIAL_UNMIXED_FRACTION

IF (INITIAL_UNMIXED_FRACTION<0._EB .OR. INITIAL_UNMIXED_FRACTION>1._EB) THEN
   WRITE(MESSAGE,'(A)')  'ERROR on MISC: Permissible values for INITIAL_UNMIXED_FRACTION=[0,1]'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

! Convert C to K for EXTINCTION 1 temperature cut-off

FREE_BURN_TEMPERATURE = FREE_BURN_TEMPERATURE + TMPM

! Don't let MAX_CHEMISTRY_SUBSTEPS change the user-specified number of substeps

IF (N_FIXED_CHEMISTRY_SUBSTEPS > 0) MAX_CHEMISTRY_SUBSTEPS = N_FIXED_CHEMISTRY_SUBSTEPS

! Check range of FUEL_X_TO_Y
IF (FUEL_C_TO_CO_FRACTION < 0._EB .OR. FUEL_C_TO_CO_FRACTION > 1._EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: FUEL_C_TO_CO_FRACTION must be between 0 and 1.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF
IF (FUEL_H_TO_H2_FRACTION < 0._EB .OR. FUEL_H_TO_H2_FRACTION > 1._EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: FUEL_H_TO_H2_FRACTION must be between 0 and 1.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF
IF (FUEL_N_TO_HCN_FRACTION < 0._EB .OR. FUEL_N_TO_HCN_FRACTION > 1._EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: FUEL_N_TO_HCN_FRACTION must be between 0 and 1.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

END SUBROUTINE READ_COMB


!> \brief Read the REAC namelist line(s), gas phase reaction parameters

SUBROUTINE READ_REAC

USE PROPERTY_DATA, ONLY : ELEMENT,GET_FORMULA_WEIGHT,MAKE_PERIODIC_TABLE,SIMPLE_SPECIES_MW,GAS_PROPS,&
                          LOOKUP_CHI_R,LOOKUP_CRITICAL_FLAME_TEMPERATURE,LOOKUP_LOWER_OXYGEN_LIMIT
USE MATH_FUNCTIONS, ONLY : GET_RAMP_INDEX,GET_TABLE_INDEX
CHARACTER(LABEL_LENGTH) :: FUEL,RADCAL_ID='null',SPEC_ID_NU(MAX_SPECIES),SPEC_ID_N_S(MAX_SPECIES),RAMP_CHI_R
CHARACTER(FORMULA_LENGTH) :: FORMULA
CHARACTER(255) :: EQUATION
CHARACTER(100) :: FWD_ID
INTEGER :: NR,NS,NS2,NFR,PRIORITY
REAL(EB) :: SOOT_YIELD,CO_YIELD,HCN_YIELD,EPUMO2,A,LOWER_OXYGEN_LIMIT, &
            CRITICAL_FLAME_TEMPERATURE,HEAT_OF_COMBUSTION,HOC_COMPLETE,E,C,H,N,O, &
            SOOT_H_FRACTION,N_T,K,NU(MAX_SPECIES),N_S(MAX_SPECIES)
REAL(EB) :: E_TMP=0._EB,S_TMP=0._EB,ATOM_COUNTS(118),MW_FUEL=0._EB,H_F=0._EB,PR_TMP=0._EB
LOGICAL :: L_TMP,CHECK_ATOM_BALANCE,REVERSE,THIRD_BODY
NAMELIST /REAC/ A,AIT_EXCLUSION_ZONE,AUTO_IGNITION_TEMPERATURE,C,CHECK_ATOM_BALANCE,CO_YIELD,CRITICAL_FLAME_TEMPERATURE,&
                E,EPUMO2,K,EQUATION,FORMULA,FUEL,&
                FUEL_RADCAL_ID,FWD_ID,FYI,H,HCN_YIELD,HEAT_OF_COMBUSTION,HOC_COMPLETE,&
                ID,IDEAL,LOWER_OXYGEN_LIMIT,N,NU,N_S,N_T,O,PRIORITY,RADIATIVE_FRACTION,&
                RAMP_CHI_R,REAC_ATOM_ERROR,REAC_MASS_ERROR,REVERSE,SOOT_H_FRACTION,SOOT_YIELD,&
                SPEC_ID_N_S,SPEC_ID_NU,THIRD_BODY

CALL MAKE_PERIODIC_TABLE
CALL SIMPLE_SPECIES_MW
ATOM_COUNTS = 0._EB
N_REACTIONS = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

COUNT_REAC_LOOP: DO
   CALL CHECKREAD('REAC',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_REAC_LOOP
   CALL SET_REAC_DEFAULTS
   READ(LU_INPUT,REAC,END=435,ERR=434,IOSTAT=IOS)
   N_REACTIONS = N_REACTIONS + 1
   IF (A < 0._EB .AND. E < 0._EB .AND. TRIM(SPEC_ID_NU(1))=='null' .AND. TRIM(EQUATION)=='null') SIMPLE_CHEMISTRY = .TRUE.
   IF ((A > 0._EB .OR. E > 0._EB) .AND. (SPEC_ID_N_S(1)=='null' .OR. N_S(1) < -998._EB)) THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Problem with REAC ',N_REACTIONS,'. SPEC_ID_N_S and N_S arrays must be defined'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (.NOT.SIMPLE_CHEMISTRY .AND. TRIM(SPEC_ID_NU(1))=='null' .AND. TRIM(EQUATION)=='null') THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Problem with REAC ',N_REACTIONS,'. SPEC_ID_NU and NU arrays or EQUATION must be defined'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   434 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0)') 'ERROR: Problem with REAC ',N_REACTIONS+1
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDDO COUNT_REAC_LOOP

! Experimental 2 reaction SIMPLE_CHEMISTRY

IF (N_SIMPLE_CHEMISTRY_REACTIONS==2) N_REACTIONS = 2

435 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

ALLOCATE(REACTION(N_REACTIONS),STAT=IZERO)

! Read and store the reaction parameters

NFR = 0 ! Number of fast reactions

REAC_READ_LOOP: DO NR=1,N_REACTIONS

   ! Read the REAC line

   IF (NR==2 .AND. N_SIMPLE_CHEMISTRY_REACTIONS==2) THEN
      CALL SET_REAC_DEFAULTS
      FUEL = 'INTERMEDIATE PRODUCTS'
      PRIORITY = 2
   ELSE
      CALL CHECKREAD('REAC',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT REAC_READ_LOOP
      CALL SET_REAC_DEFAULTS
      READ(LU_INPUT,REAC)
   ENDIF

   ! Ensure that there is a specified fuel

   IF (FUEL=='null' .AND. ID/='null') FUEL = ID ! Backward compatibility

   IF (FUEL=='null' .AND. ID=='null') THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: REAC ',NR,' requires a FUEL'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Set up the SIMPLE_CHEMISTRY model

   RN => REACTION(NR)
   IF (SIMPLE_CHEMISTRY) THEN
      IF(C<=TWO_EPSILON_EB .AND. H<=TWO_EPSILON_EB) THEN
         IF (TRIM(FORMULA)=='null') THEN
            CALL GAS_PROPS(FUEL,S_TMP,E_TMP,PR_TMP,MW_FUEL,FORMULA,L_TMP,ATOM_COUNTS,H_F,RADCAL_ID)
         ELSE
            CALL GET_FORMULA_WEIGHT(FORMULA,MW_FUEL,ATOM_COUNTS)
            L_TMP = .TRUE.
         ENDIF
         IF (L_TMP) THEN
            SIMPLE_FUEL_DEFINED = .TRUE.
            IF (ATOM_COUNTS(1)+ATOM_COUNTS(6)+ATOM_COUNTS(7)+ATOM_COUNTS(8) - SUM(ATOM_COUNTS) < 0._EB) THEN
               WRITE(MESSAGE,'(A)') 'ERROR: Fuel FORMULA for SIMPLE_CHEMISTRY can only contain C,H,O, and N'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ELSE
               C = ATOM_COUNTS(6)
               H = ATOM_COUNTS(1)
               O = ATOM_COUNTS(8)
               N = ATOM_COUNTS(7)
            ENDIF
            IF (C<=TWO_EPSILON_EB .AND. H<=TWO_EPSILON_EB) THEN
               WRITE(MESSAGE,'(A)') 'ERROR: Must specify fuel chemistry using C and/or H when using simple chemistry'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDIF
      ELSE
         SIMPLE_FUEL_DEFINED = .TRUE.
         MW_FUEL = ELEMENT(6)%MASS*C+ELEMENT(1)%MASS*H+ELEMENT(8)%MASS*O+ELEMENT(7)%MASS*N
      ENDIF
   ENDIF
   RN%A_IN                      = A
   RN%A_PRIME                   = A
   RN%C                         = C
   RN%CHECK_ATOM_BALANCE        = CHECK_ATOM_BALANCE
   RN%CO_YIELD                  = CO_YIELD
   IF (CRITICAL_FLAME_TEMPERATURE<0._EB) CALL LOOKUP_CRITICAL_FLAME_TEMPERATURE(FUEL,CRITICAL_FLAME_TEMPERATURE)
   RN%CRIT_FLAME_TMP            = CRITICAL_FLAME_TEMPERATURE + TMPM
   RN%E                         = E*1000._EB
   RN%E_IN                      = E
   RN%K                         = K
   RN%EQUATION                  = EQUATION
   RN%EPUMO2                    = EPUMO2*1000._EB
   RN%FUEL                      = FUEL
   RN%FWD_ID                    = FWD_ID
   RN%FYI                       = FYI
   RN%H                         = H
   RN%HCN_YIELD                 = HCN_YIELD
   RN%HEAT_OF_COMBUSTION        = HEAT_OF_COMBUSTION*1000._EB
   RN%HOC_COMPLETE              = HOC_COMPLETE*1000._EB
   RN%ID                        = ID
   IF (LOWER_OXYGEN_LIMIT<0._EB) CALL LOOKUP_LOWER_OXYGEN_LIMIT(FUEL,LOWER_OXYGEN_LIMIT)
   RN%Y_O2_MIN                  = LOWER_OXYGEN_LIMIT*MW_O2/(LOWER_OXYGEN_LIMIT*MW_O2+(1._EB-LOWER_OXYGEN_LIMIT)*MW_N2)
   RN%MW_FUEL                   = MW_FUEL
   RN%MW_SOOT                   = ELEMENT(6)%MASS * (1._EB-SOOT_H_FRACTION) + ELEMENT(1)%MASS*SOOT_H_FRACTION
   RN%N                         = N
   RN%N_T                       = N_T
   RN%PRIORITY                  = PRIORITY
   MAX_PRIORITY                 = MAX(MAX_PRIORITY,PRIORITY)
   RN%O                         = O
   RN%RAMP_CHI_R                = RAMP_CHI_R
   RN%REVERSE                   = REVERSE
   RN%SOOT_H_FRACTION           = SOOT_H_FRACTION
   RN%SOOT_YIELD                = SOOT_YIELD
   RN%THIRD_BODY                = THIRD_BODY

   IF (RN%RAMP_CHI_R/='null') CALL GET_RAMP_INDEX(RN%RAMP_CHI_R,'TIME',RN%RAMP_CHI_R_INDEX)

   IF (RN%A_PRIME==-1._EB .AND. RN%E==-1000._EB .AND. .NOT.RN%REVERSE) THEN
      RN%FAST_CHEMISTRY=.TRUE.
      NFR = NFR + 1
   ENDIF

   ! Determine the number of stoichiometric coefficients for this reaction

   IF (.NOT.SIMPLE_CHEMISTRY) THEN
      NS2 = 0
      DO NS=1,MAX_SPECIES
         IF (TRIM(SPEC_ID_NU(NS))/='null') THEN
            NS2=NS2+1
         ELSE
            EXIT
         ENDIF
      ENDDO
      RN%N_SMIX = NS2
      NS2 = 0
      IF(TRIM(RN%EQUATION)/='null') RN%N_SMIX = MAX_SPECIES
      DO NS=1,MAX_SPECIES
         IF (TRIM(SPEC_ID_N_S(NS))/='null') THEN
            NS2=NS2+1
         ELSE
            EXIT
         ENDIF
      ENDDO
      RN%N_SPEC = NS2
   ELSE
      RN%N_SMIX = 3
      RN%N_SPEC = 0
   ENDIF

   ! Store the "read in" values of N_S, NU, and SPEC_ID_NU for use in PROC_REAC.

   IF (RN%N_SPEC > 0) THEN
      ALLOCATE(RN%N_S_READ(RN%N_SPEC))
      RN%N_S_READ(1:RN%N_SPEC) = N_S(1:RN%N_SPEC)
      ALLOCATE(RN%SPEC_ID_N_S_READ(RN%N_SPEC))
      RN%SPEC_ID_N_S_READ = 'null'
      RN%SPEC_ID_N_S_READ(1:RN%N_SPEC)=SPEC_ID_N_S(1:RN%N_SPEC)
   ENDIF
   ALLOCATE(RN%NU_READ(RN%N_SMIX))
   RN%NU_READ(1:RN%N_SMIX) = NU(1:RN%N_SMIX)

   ALLOCATE(RN%SPEC_ID_NU_READ(RN%N_SMIX))
   RN%SPEC_ID_NU_READ = 'null'
   RN%SPEC_ID_NU_READ(1:RN%N_SMIX)=SPEC_ID_NU(1:RN%N_SMIX)

   IF (RADIATIVE_FRACTION < 0._EB) THEN
      IF (SIM_MODE==DNS_MODE) THEN
         RN%CHI_R = 0._EB
      ELSE
         CALL LOOKUP_CHI_R(FUEL,RN%CHI_R)
      ENDIF
   ELSE
      RN%CHI_R = RADIATIVE_FRACTION
   ENDIF

ENDDO REAC_READ_LOOP

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

CONTAINS

SUBROUTINE SET_REAC_DEFAULTS

A                           = -1._EB
C                           = 0._EB
CHECK_ATOM_BALANCE          = .TRUE.
CO_YIELD                    = 0._EB
CRITICAL_FLAME_TEMPERATURE  = -1._EB     ! Values for various fuels and default are in data.f90
E                           = -1._EB     ! J/mol
EPUMO2                      = 13100._EB  ! kJ/kg
K                           = 1._EB
EQUATION                    = 'null'
FORMULA                     = 'null'
FUEL                        = 'null'
FWD_ID                      = 'null'
FYI                         = 'null'
H                           = 0._EB
HEAT_OF_COMBUSTION          = -2.E20_EB
HCN_YIELD                   = 0._EB
HOC_COMPLETE                = -1._EB
ID                          = 'null'
LOWER_OXYGEN_LIMIT          = -1._EB
N                           = 0._EB
NU                          = 0._EB
N_S                         = -999._EB
N_T                         = 0._EB
O                           = 0._EB
PRIORITY                    = 1
RAMP_CHI_R                  = 'null'
REAC_ATOM_ERROR             = 1.E-4_EB
REAC_MASS_ERROR             = 1.E-4_EB
REVERSE                     = .FALSE.
SOOT_H_FRACTION             = 0.1_EB
SOOT_YIELD                  = 0.0_EB
SPEC_ID_NU                  = 'null'
SPEC_ID_N_S                 = 'null'
THIRD_BODY                  = .FALSE.

END SUBROUTINE SET_REAC_DEFAULTS


END SUBROUTINE READ_REAC


SUBROUTINE PROC_REAC_1
USE PROPERTY_DATA, ONLY : PARSE_EQUATION, SHUTDOWN_ATOM
REAL(EB) :: MASS_PRODUCT,MASS_REACTANT,REACTION_BALANCE(118)
INTEGER :: NS,NS2,NR,NSPEC
LOGICAL :: NAME_FOUND,SKIP_ATOM_BALANCE
TYPE (SPECIES_MIXTURE_TYPE), POINTER :: SM

IF (N_REACTIONS <=0) RETURN

! Basic input error checking

IF (SIMPLE_CHEMISTRY .AND. N_REACTIONS > 1 .AND. N_SIMPLE_CHEMISTRY_REACTIONS==1) THEN
   WRITE(MESSAGE,'(A)') 'ERROR: can not have more than one reaction when using simple chemistry'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

! The following information is what the user would have entered into the input file in the more general case

IF (SIMPLE_CHEMISTRY) THEN
   SELECT CASE(N_SIMPLE_CHEMISTRY_REACTIONS)
      CASE(1)
         RN => REACTION(1)
         IF (RN%NU_O2<=0._EB) THEN
            WRITE(MESSAGE,'(A)') 'ERROR: Fuel specified for simple chemistry has NU_O2 <=0 and it must require air for combustion.'
            CALL SHUTDOWN(MESSAGE)       ; RETURN
         ENDIF
         RN%SPEC_ID_NU_READ(1) = RN%FUEL
         RN%SPEC_ID_NU_READ(2) = 'AIR'
         RN%SPEC_ID_NU_READ(3) = 'PRODUCTS'
         RN%NU_READ(1)      = -1._EB
         RN%NU_READ(2)      = -RN%NU_O2/SPECIES_MIXTURE(1)%VOLUME_FRACTION(O2_INDEX)
         RN%NU_READ(3)      = -(RN%NU_READ(1)*SPECIES_MIXTURE(FUEL_SMIX_INDEX)%MW+RN%NU_READ(2)*SPECIES_MIXTURE(1)%MW)/ &
                              SPECIES_MIXTURE(3)%MW
         RN%N_SMIX          = 3
     CASE(2)
         RN => REACTION(1)
         IF (RN%NU_O2<=0._EB) THEN
            WRITE(MESSAGE,'(A)') 'ERROR: Fuel specified for simple chemistry has NU_O2 <=0 and it must require air for combustion.'
            CALL SHUTDOWN(MESSAGE)       ; RETURN
         ENDIF
         RN%SPEC_ID_NU_READ(1) = RN%FUEL
         RN%SPEC_ID_NU_READ(2) = 'AIR'
         RN%SPEC_ID_NU_READ(3) = 'INTERMEDIATE PRODUCTS'
         RN%NU_READ(1)      = -1._EB
         RN%NU_READ(2)      = -RN%NU_O2/SPECIES_MIXTURE(1)%VOLUME_FRACTION(O2_INDEX)
         RN%NU_READ(3)      = -(RN%NU_READ(1)*SPECIES_MIXTURE(FUEL_SMIX_INDEX)%MW+RN%NU_READ(2)*SPECIES_MIXTURE(1)%MW)/ &
                              SPECIES_MIXTURE(4)%MW
         RN%N_SMIX          = 3
         RN => REACTION(2)
         RN%SPEC_ID_NU_READ(1) = 'INTERMEDIATE PRODUCTS'
         RN%SPEC_ID_NU_READ(2) = 'AIR'
         RN%SPEC_ID_NU_READ(3) = 'PRODUCTS'
         RN%NU_READ(1)      = -REACTION(1)%NU_READ(3)
         RN%NU_READ(2)      = -(REACTION(2)%NU_O2-REACTION(1)%NU_O2)/SPECIES_MIXTURE(1)%VOLUME_FRACTION(O2_INDEX)
         RN%NU_READ(3)      = -(REACTION(1)%NU_READ(1)*SPECIES_MIXTURE(FUEL_SMIX_INDEX)%MW+&
                               (REACTION(1)%NU_READ(2)+REACTION(2)%NU_READ(2))*SPECIES_MIXTURE(1)%MW)/SPECIES_MIXTURE(3)%MW
         RN%N_SMIX          = 3
   END SELECT
ENDIF

REAC_LOOP: DO NR=1,N_REACTIONS

   RN => REACTION(NR)

   IF ((RN%A_PRIME > 0._EB .OR. RN%E > 0._EB) .AND. (RN%C>TWO_EPSILON_EB .OR. RN%H>TWO_EPSILON_EB)) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: cannot use both finite rate REAC and simple chemistry'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (TRIM(RN%EQUATION)/='null') THEN
      IF(ANY(ABS(RN%NU_READ)>TWO_EPSILON_EB)) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Problem with REAC ',NR,'. Cannot set NUs if an EQUATION is specified.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      CALL PARSE_EQUATION(NR)
      IF (STOP_STATUS==SETUP_STOP) RETURN
      RN%N_SMIX = 0
      DO NS=1,N_TRACKED_SPECIES+1
         IF(ABS(RN%NU_READ(NS))>TWO_EPSILON_EB) THEN
            RN%N_SMIX = RN%N_SMIX+1
         ENDIF
      ENDDO
   ENDIF

   IF (TRIM(RN%FUEL)=='null') THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Problem with REAC ',NR,'. FUEL must be defined'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Allocate the arrays that are going to carry the mixture stoichiometry to the rest of the code

   ALLOCATE(RN%SPEC_ID_NU(1:N_TRACKED_SPECIES))
   ALLOCATE(RN%NU(1:N_TRACKED_SPECIES))
   ALLOCATE(RN%NU_MW_O_MW_F(1:N_TRACKED_SPECIES))
   ALLOCATE(RN%SPEC_ID_N_S(1:N_SPECIES))
   ALLOCATE(RN%N_S(1:N_SPECIES))
   RN%SPEC_ID_NU  = 'null'
   RN%SPEC_ID_N_S = 'null'
   RN%NU          = 0._EB
   RN%N_S         = -999._EB

   ! Transfer SPEC_ID_NU, SPEC_ID_N, NU, and N_S that were indexed by the order they were read in
   ! to now be indexed by the SMIX or SPEC index

   DO NS=1,RN%N_SMIX
      IF (TRIM(RN%SPEC_ID_NU_READ(NS))=='null') CYCLE
      NAME_FOUND = .FALSE.
      DO NS2=1,N_TRACKED_SPECIES
         IF (TRIM(RN%SPEC_ID_NU_READ(NS))==TRIM(SPECIES_MIXTURE(NS2)%ID)) THEN
            RN%SPEC_ID_NU(NS2) = RN%SPEC_ID_NU_READ(NS)
            RN%NU(NS2)      = RN%NU_READ(NS)
            NAME_FOUND = .TRUE.
            EXIT
         ENDIF
      ENDDO
      IF (.NOT. NAME_FOUND) THEN
         WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Problem with REAC ',NR,'. Tracked species ',TRIM(RN%SPEC_ID_NU_READ(NS)),&
                                       ' not found.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO

   ! Look for indices of fuels, oxidizers, and products. Normalize the stoichiometric coefficients by that of the fuel.

   DO NS2=1,N_TRACKED_SPECIES
      IF (ABS(RN%NU(NS2))<TWO_EPSILON_EB) CYCLE
      DO NSPEC=1,N_SPECIES
         IF (SPECIES_MIXTURE(NS2)%SPEC_ID(NSPEC)==RN%FUEL .OR. SPECIES_MIXTURE(NS2)%ID==RN%FUEL) THEN
            RN%FUEL_SMIX_INDEX = NS2
            RN%NU = -RN%NU/RN%NU(NS2)
            EXIT
         ENDIF
      ENDDO
   ENDDO

   IF (RN%FUEL_SMIX_INDEX < 0) THEN
         WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Problem with REAC ',NR,'. Fuel species ',TRIM(RN%FUEL),' not found.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Find AIR index

   GET_AIR_INDEX_LOOP: DO NS = 1,N_TRACKED_SPECIES
      IF (RN%NU(NS) < 0._EB .AND. NS /= RN%FUEL_SMIX_INDEX) THEN
         RN%AIR_SMIX_INDEX = NS
         EXIT GET_AIR_INDEX_LOOP
      ENDIF
   ENDDO GET_AIR_INDEX_LOOP

   ! Adjust mol/cm^3/s based rate to kg/m^3/s rate

   RN%RHO_EXPONENT = 0._EB
   DO NS=1,RN%N_SPEC
      IF (TRIM(RN%SPEC_ID_N_S_READ(NS))=='null') CYCLE
      IF (RN%A_PRIME < 0.0_EB) CYCLE
      NAME_FOUND = .FALSE.
      DO NS2=1,N_SPECIES
         IF (TRIM(RN%SPEC_ID_N_S_READ(NS))==TRIM(SPECIES(NS2)%ID)) THEN
            RN%SPEC_ID_N_S(NS2) = RN%SPEC_ID_N_S_READ(NS)
            RN%N_S(NS2)       = RN%N_S_READ(NS)
            RN%A_PRIME        = RN%A_PRIME * (1000._EB*SPECIES(NS2)%MW)**(-RN%N_S(NS2)) ! FDS Tech Guide, Eq. (5.46), product term
            RN%RHO_EXPONENT   = RN%RHO_EXPONENT + RN%N_S(NS2)
            NAME_FOUND = .TRUE.
            EXIT
         ENDIF
      ENDDO
      IF (.NOT. NAME_FOUND) THEN
         WRITE(MESSAGE,'(A,I0,A,A,A)') &
            'ERROR: Problem with REAC ',NR,'. Primitive species ',TRIM(RN%SPEC_ID_N_S_READ(NS)),' not found.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO
   RN%RHO_EXPONENT = RN%RHO_EXPONENT - 1._EB ! subtracting 1 accounts for division by rho in Eq. (5.49)
   RN%A_PRIME = RN%A_PRIME * 1000._EB*SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW ! conversion terms in Eq. (5.46)

   ! Adjust mol/cm^3/s based rate to kg/m^3/s rate for FAST_CHEMISTRY (this will get removed when we overhaul combustion)
   ! Fictitious Arrhenius rate is dC_F/dt = -1E10*C_F*C_A

   IF (RN%FAST_CHEMISTRY) THEN
      IF (RN%AIR_SMIX_INDEX > -1) THEN
         RN%RHO_EXPONENT_FAST = 1._EB
         RN%A_PRIME_FAST = 1.E10_EB*(1000._EB*SPECIES_MIXTURE(RN%AIR_SMIX_INDEX)%MW)**(-1._EB)
      ELSE
         RN%RHO_EXPONENT_FAST = 0._EB
         RN%A_PRIME_FAST = 1.E10_EB
      ENDIF
   ENDIF

   ! Compute the primitive species reaction coefficients

   ALLOCATE(RN%NU_SPECIES(N_SPECIES))
   RN%NU_SPECIES = 0._EB
   DO NS=1,N_TRACKED_SPECIES
      SM => SPECIES_MIXTURE(NS)
      RN%NU(NS) = RN%NU(NS)*SM%ADJUST_NU
      DO NS2 = 1,N_SPECIES
         RN%NU_SPECIES(NS2) =  RN%NU_SPECIES(NS2) + RN%NU(NS)*SM%VOLUME_FRACTION(NS2)
      ENDDO
      IF (SM%ID=='WATER VAPOR')  I_WATER = NS
   ENDDO

   ! Check atom balance of the reaction

   IF (.NOT. SIMPLE_CHEMISTRY .AND. RN%CHECK_ATOM_BALANCE) THEN
      SKIP_ATOM_BALANCE = .FALSE.
      REACTION_BALANCE = 0._EB
      DO NS=1,N_TRACKED_SPECIES
         IF (ABS(RN%NU(NS))>TWO_EPSILON_EB .AND. .NOT. SPECIES_MIXTURE(NS)%VALID_ATOMS) SKIP_ATOM_BALANCE = .TRUE.
         REACTION_BALANCE = REACTION_BALANCE + RN%NU(NS)*SPECIES_MIXTURE(NS)%ATOMS
      ENDDO
      IF (ANY(ABS(REACTION_BALANCE)>REAC_ATOM_ERROR) .AND. .NOT. SKIP_ATOM_BALANCE) THEN
         CALL SHUTDOWN_ATOM(REACTION_BALANCE,NR,REAC_ATOM_ERROR) ; RETURN
      ENDIF
   ENDIF

   ! Check the mass balance of the reaction

   MASS_REACTANT = 0._EB
   MASS_PRODUCT  = 0._EB

   DO NS=1,N_TRACKED_SPECIES
      IF (RN%NU(NS) < -TWO_EPSILON_EB) MASS_REACTANT = MASS_REACTANT + RN%NU(NS)*SPECIES_MIXTURE(NS)%MW
      IF (RN%NU(NS) >  TWO_EPSILON_EB) MASS_PRODUCT  = MASS_PRODUCT  + RN%NU(NS)*SPECIES_MIXTURE(NS)%MW
   ENDDO
   IF (ABS(MASS_PRODUCT) < TWO_EPSILON_EB .OR. ABS(MASS_REACTANT) < TWO_EPSILON_EB) THEN
      IF (ABS(MASS_PRODUCT) <TWO_EPSILON_EB) WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Problem with REAC ',NR,'. Products not specified.'
      IF (ABS(MASS_REACTANT)<TWO_EPSILON_EB) WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Problem with REAC ',NR,'. Reactants not specified.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (ABS(MASS_PRODUCT+MASS_REACTANT)/ABS(MASS_PRODUCT) > REAC_MASS_ERROR) THEN
      WRITE(MESSAGE,'(A,I0,A,F8.3,A,F8.3)') 'ERROR: Problem with REAC ',NR,'. Mass of products, ',MASS_PRODUCT, &
         ', does not equal mass of reactants,',-MASS_REACTANT
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Mass stoichiometric coefficient of oxidizer

   DO NS=1,N_TRACKED_SPECIES
      RN%NU_MW_O_MW_F(NS) = RN%NU(NS)*SPECIES_MIXTURE(NS)%MW/SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW
      IF (RN%NU(NS)< 0._EB .AND. NS /= RN%FUEL_SMIX_INDEX) THEN
         RN%S = -RN%NU_MW_O_MW_F(NS)
      ENDIF
   ENDDO

ENDDO REAC_LOOP

! Select integrator

IF (TRIM(ODE_SOLVER)/='null') THEN
   SELECT CASE (TRIM(ODE_SOLVER))
      CASE ('EXPLICIT EULER') ; COMBUSTION_ODE_SOLVER = EXPLICIT_EULER
      CASE ('RK2')            ; COMBUSTION_ODE_SOLVER = RK2
      CASE ('RK3')            ; COMBUSTION_ODE_SOLVER = RK3
      CASE ('RK2 RICHARDSON') ; COMBUSTION_ODE_SOLVER = RK2_RICHARDSON
      CASE DEFAULT
         WRITE(MESSAGE,'(A)') 'ERROR: Problem with REAC. Name of ODE_SOLVER is not recognized.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   END SELECT
ELSE
   FAST_CHEM_LOOP: DO NR = 1,N_REACTIONS
      RN => REACTION(NR)
      IF (.NOT. RN%FAST_CHEMISTRY) THEN
         COMBUSTION_ODE_SOLVER = RK2_RICHARDSON
         EXIT FAST_CHEM_LOOP
      ELSE
         COMBUSTION_ODE_SOLVER = EXPLICIT_EULER
      ENDIF
   ENDDO FAST_CHEM_LOOP
ENDIF

END SUBROUTINE PROC_REAC_1


SUBROUTINE PROC_REAC_2
INTEGER :: NS,NR,HF_COUNT,I_HFRT
REAL(EB) :: H_F_OLD(1:N_TRACKED_SPECIES),D_HFRT,D_H,R1_HOC_COMPUTED
LOGICAL :: REDEFINE_H_F(1:N_TRACKED_SPECIES),LISTED_FUEL
TYPE (SPECIES_MIXTURE_TYPE), POINTER :: SM,SMF

IF (N_REACTIONS <=0) RETURN

REDEFINE_H_F = .FALSE.
LISTED_FUEL = .FALSE.
H_F_OLD = SPECIES_MIXTURE%H_F

REAC_LOOP: DO NR=1,N_REACTIONS

   RN => REACTION(NR)
   SMF => SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)
   IF (SIMPLE_CHEMISTRY) THEN
      LISTED_FUEL = .TRUE.
      DO NS=1,N_SPECIES
         IF (SMF%VOLUME_FRACTION(NS)>0._EB .AND. .NOT. SPECIES(NS)%EXPLICIT_H_F) LISTED_FUEL=.FALSE.
         IF (.NOT. SPECIES(NS)%LISTED .AND. SPECIES(NS)%RADCAL_ID=='null') SPECIES(NS)%RADCAL_ID=FUEL_RADCAL_ID
      ENDDO
   ENDIF

   ! Heat of Combustion calculation

   HOC_IF: IF (RN%HEAT_OF_COMBUSTION > -1.E21) THEN ! User specified heat of combustion
      IF (SIMPLE_CHEMISTRY) THEN
         IF (IDEAL) THEN
            RN%HEAT_OF_COMBUSTION = RN%HEAT_OF_COMBUSTION * SMF%MW * 0.001 !J/kg -> J/mol
            RN%HEAT_OF_COMBUSTION = RN%HEAT_OF_COMBUSTION + ( &
                           RN%NU_CO * (SPECIES(CO2_INDEX)%H_F - SPECIES(CO_INDEX)%H_F) &
                         + RN%NU_SOOT * SPECIES(CO2_INDEX)%H_F * (1._EB - RN%SOOT_H_FRACTION) &
                         + RN%NU_SOOT * SPECIES(H2O_INDEX)%H_F * RN%SOOT_H_FRACTION * 0.5_EB &
                         + RN%NU_HCN * (SPECIES(CO2_INDEX)%H_F - SPECIES(HCN_INDEX)%H_F) &
                         + RN%NU_HCN * (SPECIES(H2O_INDEX)%H_F*0.5_EB - SPECIES(HCN_INDEX)%H_F))
            RN%HEAT_OF_COMBUSTION = RN%HEAT_OF_COMBUSTION / SMF%MW * 1000._EB !J/mol->J/kg
         ENDIF
         RN%EPUMO2 = RN%HEAT_OF_COMBUSTION*SMF%MW / (RN%NU_O2 * SPECIES(O2_INDEX)%MW)
      ENDIF
      HF_COUNT = 0
      DO NS = 1,N_TRACKED_SPECIES
         IF (RN%NU(NS) /= 0._EB) THEN
            IF (SPECIES_MIXTURE(NS)%H_F <= -1.E21) HF_COUNT = HF_COUNT +1
            IF (HF_COUNT > 1) THEN
               WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Problem with REAC ',NR,'. Missing more than 1 species heat of formation.'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDIF
      ENDDO
      ! Find heat of formation of lumped fuel to satisfy specified heat of combustion
      IF (REDEFINE_H_F(RN%FUEL_SMIX_INDEX)) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'WARNING: H_F for FUEL for REACtion ',NR,' was redefined multiple times.'
         IF (MYID==0) WRITE(LU_ERR,'(A)') TRIM(MESSAGE)
      ENDIF
      REDEFINE_H_F(RN%FUEL_SMIX_INDEX) = .TRUE.
      SMF%H_F = RN%HEAT_OF_COMBUSTION * ABS(RN%NU(RN%FUEL_SMIX_INDEX)) * SMF%MW * 0.001_EB
      DO NS = 1,N_TRACKED_SPECIES
         IF  (NS == RN%FUEL_SMIX_INDEX) CYCLE
            SM=>SPECIES_MIXTURE(NS)
            SMF%H_F = SMF%H_F + RN%NU(NS) * SM%H_F * SM%MW * 0.001_EB
      ENDDO
      IF (SMF%SINGLE_SPEC_INDEX>0) SPECIES(SMF%SINGLE_SPEC_INDEX)%H_F = -SMF%H_F/ RN%NU(RN%FUEL_SMIX_INDEX)
      SMF%H_F = -SMF%H_F/ (RN%NU(RN%FUEL_SMIX_INDEX) * SMF%MW * 0.001_EB)

   ELSE HOC_IF ! Heat of combustion not specified

      IF (SIMPLE_CHEMISTRY) THEN ! Calculate heat of combustion based oxygen consumption
         IF (RN%EPUMO2 > 0._EB .AND. .NOT. LISTED_FUEL ) THEN
            RN%HEAT_OF_COMBUSTION = -RN%EPUMO2 * RN%NU_SPECIES(O2_INDEX) * SPECIES(O2_INDEX)%MW / SMF%MW
            REDEFINE_H_F(RN%FUEL_SMIX_INDEX) = .TRUE.
            SMF%H_F = RN%HEAT_OF_COMBUSTION * ABS(RN%NU(RN%FUEL_SMIX_INDEX)) * SMF%MW * 0.001_EB
            DO NS = 1,N_TRACKED_SPECIES
               IF  (NS == RN%FUEL_SMIX_INDEX) CYCLE
                  SM=>SPECIES_MIXTURE(NS)
                  SMF%H_F = SMF%H_F + RN%NU(NS) * SM%H_F * SM%MW * 0.001_EB
            ENDDO
            IF (SMF%SINGLE_SPEC_INDEX>0) SPECIES(SMF%SINGLE_SPEC_INDEX)%H_F = -SMF%H_F/ RN%NU(RN%FUEL_SMIX_INDEX)
            SMF%H_F = -SMF%H_F/ (RN%NU(RN%FUEL_SMIX_INDEX) * SMF%MW * 0.001_EB)
         ELSE
            RN%HEAT_OF_COMBUSTION = 0._EB
            DO NS = 1,N_TRACKED_SPECIES
               SM=>SPECIES_MIXTURE(NS)
               RN%HEAT_OF_COMBUSTION = RN%HEAT_OF_COMBUSTION - RN%NU(NS) * SM%H_F * SM%MW
            ENDDO
            RN%HEAT_OF_COMBUSTION =  RN%HEAT_OF_COMBUSTION / SMF%MW
            RN%EPUMO2 = RN%HEAT_OF_COMBUSTION * SMF%MW / (RN%NU_O2 * SPECIES(O2_INDEX)%MW)
         ENDIF
      ELSE
         RN%HEAT_OF_COMBUSTION = 0._EB
         DO NS = 1,N_TRACKED_SPECIES
            SM=>SPECIES_MIXTURE(NS)
            RN%HEAT_OF_COMBUSTION = RN%HEAT_OF_COMBUSTION - RN%NU(NS) * SM%H_F * SM%MW
         ENDDO
         RN%HEAT_OF_COMBUSTION = RN%HEAT_OF_COMBUSTION / SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW
      ENDIF
   ENDIF HOC_IF

ENDDO REAC_LOOP

! HOC for complete reaction with simple chemistry

IF (SIMPLE_CHEMISTRY) THEN
   IF (N_SIMPLE_CHEMISTRY_REACTIONS==1) THEN
   REACTION(1)%HOC_COMPLETE = REACTION(1)%HEAT_OF_COMBUSTION
   ELSEIF (N_SIMPLE_CHEMISTRY_REACTIONS==2) THEN
      IF (REACTION(1)%HOC_COMPLETE < 0._EB) THEN  ! Compute complete HoC using HoC for first and second reactions
         REACTION(1)%HOC_COMPLETE = REACTION(1)%HEAT_OF_COMBUSTION + (1._EB+REACTION(1)%S)*REACTION(2)%HEAT_OF_COMBUSTION
      ELSE  ! Change the HoC of reaction 1 to match user-specified value for complete reaction by changing the HoF of fuel
         R1_HOC_COMPUTED = REACTION(1)%HEAT_OF_COMBUSTION  ! Heat of combustion for reaction 1 computed using heats of formation
         REACTION(1)%HEAT_OF_COMBUSTION = REACTION(1)%HOC_COMPLETE - (1._EB+REACTION(1)%S)*REACTION(2)%HEAT_OF_COMBUSTION
         REDEFINE_H_F(REACTION(1)%FUEL_SMIX_INDEX) = .TRUE.
         SMF => SPECIES_MIXTURE(REACTION(1)%FUEL_SMIX_INDEX)
         SMF%H_F = SMF%H_F - (R1_HOC_COMPUTED - REACTION(1)%HEAT_OF_COMBUSTION)
      ENDIF
   ENDIF
ELSE
   DO NR=1,N_REACTIONS
      IF (REACTION(NR)%HOC_COMPLETE < 0._EB) REACTION(NR)%HOC_COMPLETE = REACTION(NR)%HEAT_OF_COMBUSTION
   ENDDO
ENDIF

! Correct CP_BAR array if H_F is redefined.

IF (ANY(REDEFINE_H_F)) THEN
   DO NS=1,N_TRACKED_SPECIES
      IF (.NOT.REDEFINE_H_F(NS)) CYCLE
      CPBAR_Z(0,NS) = CPBAR_Z(0,NS) + SPECIES_MIXTURE(NS)%H_F - H_F_OLD(NS)
      DO J=1,5000
         CPBAR_Z(J,NS) = CPBAR_Z(J,NS) + (SPECIES_MIXTURE(NS)%H_F - H_F_OLD(NS))/REAL(J,EB)
      ENDDO
   ENDDO
ELSE
   IF (SIMPLE_CHEMISTRY .AND. CONSTANT_SPECIFIC_HEAT_RATIO) THEN
      H_F_OLD = 0._EB
      I_HFRT = INT(H_F_REFERENCE_TEMPERATURE)
      D_HFRT = H_F_REFERENCE_TEMPERATURE - REAL(I_HFRT,EB)
      RN => REACTION(1)
      DO NS=1,N_TRACKED_SPECIES
         H_F_OLD(NS) = RN%NU(NS)*SPECIES_MIXTURE(NS)%MW*(CPBAR_Z(I_HFRT,NS)+D_HFRT*(CPBAR_Z(I_HFRT+1,NS)-CPBAR_Z(I_HFRT,NS)))
      ENDDO
      H_F_OLD = H_F_OLD*H_F_REFERENCE_TEMPERATURE
      D_H = -SUM(H_F_OLD)/SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW-RN%HEAT_OF_COMBUSTION
      CPBAR_Z(0,RN%FUEL_SMIX_INDEX) = CPBAR_Z(0,RN%FUEL_SMIX_INDEX) - D_H
      DO J=1,5000
         CPBAR_Z(J,RN%FUEL_SMIX_INDEX) = CPBAR_Z(J,RN%FUEL_SMIX_INDEX) -D_H/REAL(J,EB)
      ENDDO
   ENDIF
ENDIF

END SUBROUTINE PROC_REAC_2


SUBROUTINE READ_PART

USE MATH_FUNCTIONS, ONLY : GET_RAMP_INDEX,GET_TABLE_INDEX
USE DEVICE_VARIABLES, ONLY : PROPERTY_TYPE
USE RADCONS, ONLY : MIE_NDG
INTEGER :: SAMPLING_FACTOR,N,NN,ILPC,IPC,RGB(3),N_STRATA,N_LAGRANGIAN_CLASSES_READ
REAL(EB) :: DIAMETER, GAMMA_D,AGE,INITIAL_TEMPERATURE,HEAT_OF_COMBUSTION, &
            VERTICAL_VELOCITY,HORIZONTAL_VELOCITY,MAXIMUM_DIAMETER,MINIMUM_DIAMETER,SURFACE_DIAMETER,SIGMA_D, &
            SURFACE_TENSION,BREAKUP_RATIO,BREAKUP_GAMMA_D,BREAKUP_SIGMA_D,&
            DENSE_VOLUME_FRACTION,REAL_REFRACTIVE_INDEX,COMPLEX_REFRACTIVE_INDEX,RUNNING_AVERAGE_FACTOR,&
            RUNNING_AVERAGE_FACTOR_WALL,KILL_DIAMETER,&
            EMBER_DENSITY_THRESHOLD,EMBER_VELOCITY_THRESHOLD,PRIMARY_BREAKUP_LENGTH,&
            PRIMARY_BREAKUP_DRAG_REDUCTION_FACTOR,HEAT_TRANSFER_COEFFICIENT_GAS,HEAT_TRANSFER_COEFFICIENT_SOLID,&
            MASS_TRANSFER_COEFFICIENT
REAL(EB) :: DRAG_COEFFICIENT(3),FREE_AREA_FRACTION,PERMEABILITY(3),POROUS_VOLUME_FRACTION,SHAPE_FACTOR
REAL(EB), DIMENSION(3,10) :: ORIENTATION
REAL(EB), DIMENSION(3) :: OR_TEMP
CHARACTER(LABEL_LENGTH) :: SPEC_ID,DEVC_ID,CTRL_ID,QUANTITIES(1:10),QUANTITIES_SPEC_ID(1:10),SURF_ID,DRAG_LAW,PROP_ID, &
                 RADIATIVE_PROPERTY_TABLE='null',CNF_RAMP_ID='null',BREAKUP_CNF_RAMP_ID='null',DISTRIBUTION,BREAKUP_DISTRIBUTION
CHARACTER(25) :: COLOR
LOGICAL :: TARGET_ONLY,MASSLESS,STATIC,MONODISPERSE,BREAKUP,CHECK_DISTRIBUTION,&
           TURBULENT_DISPERSION,EMBER_PARTICLE,ADHERE_TO_SOLID
TYPE(LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC=>NULL()
NAMELIST /PART/ ADHERE_TO_SOLID,AGE,BREAKUP,BREAKUP_CNF_RAMP_ID,BREAKUP_DISTRIBUTION,BREAKUP_GAMMA_D,BREAKUP_RATIO,&
                BREAKUP_SIGMA_D,CHECK_DISTRIBUTION,CNF_RAMP_ID,COLOR,COMPLEX_REFRACTIVE_INDEX,&
                CTRL_ID,DENSE_VOLUME_FRACTION,&
                DEVC_ID,DIAMETER,DISTRIBUTION,DRAG_COEFFICIENT,DRAG_LAW,&
                EMBER_DENSITY_THRESHOLD,EMBER_PARTICLE,EMBER_VELOCITY_THRESHOLD,&
                FREE_AREA_FRACTION,FYI,GAMMA_D,HEAT_OF_COMBUSTION,HEAT_TRANSFER_COEFFICIENT_GAS,HEAT_TRANSFER_COEFFICIENT_SOLID,&
                HORIZONTAL_VELOCITY,ID,INITIAL_TEMPERATURE,KILL_DIAMETER,MASSLESS,&
                MASS_TRANSFER_COEFFICIENT,MAXIMUM_DIAMETER,&
                MINIMUM_DIAMETER,MONODISPERSE,&
                N_STRATA,ORIENTATION,PERMEABILITY,POROUS_VOLUME_FRACTION,&
                PRIMARY_BREAKUP_DRAG_REDUCTION_FACTOR,PRIMARY_BREAKUP_LENGTH,PROP_ID,QUANTITIES,&
                QUANTITIES_SPEC_ID,RADIATIVE_PROPERTY_TABLE,REAL_REFRACTIVE_INDEX,RGB,RUNNING_AVERAGE_FACTOR,&
                RUNNING_AVERAGE_FACTOR_WALL, &
                SAMPLING_FACTOR,SHAPE_FACTOR,SIGMA_D,SPEC_ID,STATIC,&
                SURFACE_DIAMETER,SURFACE_TENSION,SURF_ID,TURBULENT_DISPERSION,VERTICAL_VELOCITY

! Determine total number of PART lines in the input file

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
N_LAGRANGIAN_CLASSES = 0
N_LAGRANGIAN_CLASSES_READ = 0

COUNT_PART_LOOP: DO
   CALL CHECKREAD('PART',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_PART_LOOP
   READ(LU_INPUT,PART,END=219,ERR=220,IOSTAT=IOS)
   N_LAGRANGIAN_CLASSES_READ = N_LAGRANGIAN_CLASSES_READ + 1
   220 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with PART line') ; RETURN ; ENDIF
ENDDO COUNT_PART_LOOP
219 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

N_LAGRANGIAN_CLASSES = N_LAGRANGIAN_CLASSES_READ

! Add reserved INIT lines to account for devices for 'RADIATIVE HEAT FLUX GAS' or 'ADIABATIC SURFACE TEMPERATURE GAS'

IF (TARGET_PARTICLES_INCLUDED) N_LAGRANGIAN_CLASSES = N_LAGRANGIAN_CLASSES + 1

! Allocate the derived type array to hold information about the particle classes

IF (N_LAGRANGIAN_CLASSES>0) PARTICLE_FILE = .TRUE.
ALLOCATE(LAGRANGIAN_PARTICLE_CLASS(N_LAGRANGIAN_CLASSES),STAT=IZERO)
CALL ChkMemErr('READ','N_LAGRANGIAN_CLASSES',IZERO)

N_LP_ARRAY_INDICES = 0
IPC = 0
ILPC = 0

READ_PART_LOOP: DO N=1,N_LAGRANGIAN_CLASSES

   ! Read the PART line from the input file or set up special PARTICLE_CLASS class for water PARTICLEs or tracers

   IF (N<=N_LAGRANGIAN_CLASSES_READ) THEN

      CALL CHECKREAD('PART',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT READ_PART_LOOP
      CALL SET_PART_DEFAULTS
      READ(LU_INPUT,PART)

   ELSEIF (TARGET_PARTICLES_INCLUDED) THEN

      ! Create a class of particles that is just a target

      CALL SET_PART_DEFAULTS
      WRITE(ID,'(A)') 'RESERVED TARGET PARTICLE'
      TARGET_ONLY = .TRUE.
      STATIC = .TRUE.
      ORIENTATION(1:3,1) = (/1._EB , 0._EB , 0._EB/)  ! This is just a dummy orientation

   ENDIF

   LPC => LAGRANGIAN_PARTICLE_CLASS(N)

   ! Identify the different types of Lagrangian particles, like massless tracers, targets, droplets, etc.

   IF (SURF_ID/='null') THEN
      SOLID_PARTICLES = .TRUE.
      IF (CNF_RAMP_ID=='null') MONODISPERSE = .TRUE.
      LPC%SOLID_PARTICLE = .TRUE.
      IF (SAMPLING_FACTOR<=0) SAMPLING_FACTOR = 1
      IF (DIAMETER>0._EB) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART ',N,' cannot have both a specified DIAMETER and a SURF_ID.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF

   IF (TARGET_ONLY) THEN
      LPC%MASSLESS_TARGET = .TRUE.
      SURF_ID  = 'MASSLESS TARGET'
      SOLID_PARTICLES = .TRUE.
      IF (CNF_RAMP_ID=='null') MONODISPERSE = .TRUE.
      STATIC = .TRUE.
      IF (SAMPLING_FACTOR<=0) SAMPLING_FACTOR = 1
   ENDIF

   IF (SPEC_ID/='null') THEN
      SURF_ID = 'DROPLET'
      LPC%LIQUID_DROPLET = .TRUE.
      ADHERE_TO_SOLID = .TRUE.
      IF (SHAPE_FACTOR<0._EB) SHAPE_FACTOR = 0.25_EB
      IF (SAMPLING_FACTOR<=0) SAMPLING_FACTOR = 10
      IF (DIAMETER<=0._EB .AND. CNF_RAMP_ID=='null') THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART ',N,' requires a specified DIAMETER.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (MASSLESS) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: Cannot have MASSLESS=.TRUE. with evaporating PARTICLEs'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF

   IF (MASSLESS) THEN
      LPC%MASSLESS_TRACER = .TRUE.
      DIAMETER = 0._EB
      SURF_ID  = 'MASSLESS TRACER'
      IF (SAMPLING_FACTOR<=0) SAMPLING_FACTOR = 1
   ENDIF

   ! If particle class has no ID at this point, stop.

   IF (SURF_ID=='null') THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART ',N,' needs a SURF_ID.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! If particle class has no ID at this point, stop.

   DO I=1,10
      IF (QUANTITIES(I)=='MASS FLUX' .AND. QUANTITIES_SPEC_ID(I)=='null') THEN
         WRITE(MESSAGE,'(A)') "ERROR: PART QUANTITIES 'MASS FLUX' requires QUANTITIES_SPEC_ID."
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO

   ! Set default colors for Smokeview. Water droplets are BLUE. Fuel droplets are YELLOW. Everything else is BLACK.

   IF (TRIM(SPEC_ID)=='WATER VAPOR') THEN
      IF (ANY(RGB<0) .AND. COLOR=='null') COLOR='BLUE'
   ENDIF

   IF (SIMPLE_CHEMISTRY) THEN
      IF(TRIM(SPEC_ID)==TRIM(REACTION(1)%FUEL)) THEN
         IF (ANY(RGB<0) .AND. COLOR=='null') COLOR='YELLOW'
      ENDIF
   ENDIF

   IF (ANY(RGB<0) .AND. COLOR=='null') COLOR = 'BLACK'

   IF (COLOR /= 'null') CALL COLOR2RGB(RGB,COLOR)

   ! Determine if the SPEC_ID is OK

   LPC%SPEC_ID = SPEC_ID
   IF (LPC%LIQUID_DROPLET) THEN
      DO NN=1,N_TRACKED_SPECIES
         IF (TRIM(SPECIES_MIXTURE(NN)%ID)==TRIM(LPC%SPEC_ID)) THEN
            LPC%Z_INDEX = NN
            SPECIES_MIXTURE(NN)%EVAPORATING = .TRUE.
            EXIT
         ENDIF
      ENDDO
      IF(LPC%Z_INDEX < 0) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: PART SPEC_ID ',TRIM(LPC%SPEC_ID),' not found'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (SPECIES_MIXTURE(LPC%Z_INDEX)%SINGLE_SPEC_INDEX < 0) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART line ',N,'.  Particles cannot evaporate to a lumped species.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ELSE
         LPC%Y_INDEX = SPECIES_MIXTURE(LPC%Z_INDEX)%SINGLE_SPEC_INDEX
      ENDIF
      IF (SPECIES(LPC%Y_INDEX)%DENSITY_LIQUID > 0._EB) LPC%DENSITY=SPECIES(LPC%Y_INDEX)%DENSITY_LIQUID
   ENDIF

   ! Arrays for particle size distribution

   IF (MONODISPERSE) THEN
      LPC%N_STRATA = 1
   ELSE
      LPC%N_STRATA = N_STRATA
   ENDIF

   IF (DIAMETER > 0._EB .OR. CNF_RAMP_ID/='null') THEN
      ALLOCATE(LPC%CNF(0:NDC),STAT=IZERO)
      CALL ChkMemErr('READ','CNF',IZERO)
      ALLOCATE(LPC%CVF(0:NDC),STAT=IZERO)
      CALL ChkMemErr('READ','CVF',IZERO)
      ALLOCATE(LPC%R_CNF(0:NDC),STAT=IZERO)
      CALL ChkMemErr('READ','R_CNF',IZERO)
      ALLOCATE(LPC%STRATUM_INDEX_LOWER(LPC%N_STRATA),STAT=IZERO)
      CALL ChkMemErr('READ','STRATUM_INDEX_LOWER',IZERO)
      ALLOCATE(LPC%STRATUM_INDEX_UPPER(LPC%N_STRATA),STAT=IZERO)
      CALL ChkMemErr('READ','STRATUM_INDEX_UPPER',IZERO)
      ALLOCATE(LPC%W_CNF(LPC%N_STRATA),STAT=IZERO)
      CALL ChkMemErr('READ','W_CNF',IZERO)
   ENDIF

   ! Arrays related to particle break-up model

   IF (BREAKUP) THEN
      ALLOCATE(LPC%BREAKUP_CNF(0:NDC),STAT=IZERO)
      CALL ChkMemErr('READ','BREAKUP_CNF',IZERO)
      ALLOCATE(LPC%BREAKUP_R_CNF(0:NDC),STAT=IZERO)
      CALL ChkMemErr('READ','BREAKUP_R_CNF',IZERO)
      ALLOCATE(LPC%BREAKUP_CVF(0:NDC),STAT=IZERO)
      CALL ChkMemErr('READ','BREAKUP_CVF',IZERO)
   ENDIF

   ! Radiative property table

   IF (RADIATIVE_PROPERTY_TABLE /= 'null') THEN
      CALL GET_TABLE_INDEX(RADIATIVE_PROPERTY_TABLE,PART_RADIATIVE_PROPERTY,LPC%RADIATIVE_PROPERTY_INDEX)
      LPC%RADIATIVE_PROPERTY_TABLE_ID = RADIATIVE_PROPERTY_TABLE
   ELSE
      LPC%RADIATIVE_PROPERTY_INDEX = 0
   ENDIF

   ! Assign property data to LAGRANGIAN_PARTICLE_CLASS class

   LPC%ID                               = ID
   LPC%BREAKUP                          = BREAKUP
   LPC%BREAKUP_RATIO                    = BREAKUP_RATIO
   LPC%BREAKUP_GAMMA                    = BREAKUP_GAMMA_D
   IF ( BREAKUP_SIGMA_D > 0._EB ) THEN
      LPC%BREAKUP_SIGMA                 = BREAKUP_SIGMA_D
   ELSE
      ! per tech guide, sigma*gamma=1.15 smoothly joins Rosin-Rammler and lognormal distribustions
      LPC%BREAKUP_SIGMA                 = 1.15_EB/BREAKUP_GAMMA_D
   ENDIF
   LPC%CTRL_ID                          = CTRL_ID
   LPC%DENSE_VOLUME_FRACTION            = DENSE_VOLUME_FRACTION
   LPC%DEVC_ID                          = DEVC_ID
   LPC%TMP_INITIAL                      = INITIAL_TEMPERATURE + TMPM
   LPC%SAMPLING_FACTOR                  = SAMPLING_FACTOR
   LPC%RGB                              = RGB
   LPC%DIAMETER                         = DIAMETER*1.E-6_EB
   LPC%MEAN_DROPLET_VOLUME              = FOTHPI*(0.5_EB*LPC%DIAMETER)**3 ! recomputed for distributions
   LPC%MAXIMUM_DIAMETER                 = MAXIMUM_DIAMETER*1.E-6_EB
   IF (MINIMUM_DIAMETER<0._EB)     &
      LPC%MINIMUM_DIAMETER              = 0.005_EB*LPC%DIAMETER
   LPC%KILL_RADIUS                      = 0.5_EB*KILL_DIAMETER*1.E-6
   IF (LPC%LIQUID_DROPLET) THEN !Set KILL_RADIUS for SURF_ID in PROC_PART
      IF (LPC%KILL_RADIUS<0._EB) THEN
         IF (MONODISPERSE) THEN         ! Kill if volume of droplet <= 0.005*volume of droplet with DIAMETER or MINIMUM_DIAMETER
            LPC%KILL_RADIUS             = (0.005_EB*(0.5_EB*LPC%DIAMETER)**3)**ONTH
         ELSE
            LPC%KILL_RADIUS             = (0.005_EB*(0.5_EB*LPC%MINIMUM_DIAMETER)**3)**ONTH
         ENDIF
      ELSE
         IF (.NOT. MONODISPERSE .AND. KILL_DIAMETER >= LPC%MINIMUM_DIAMETER) THEN
            WRITE(MESSAGE,'(A,A)') 'KILL DIAMETER >= MINIMUM_DIAMETER for particle class ',LPC%ID
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (MONODISPERSE .AND. KILL_DIAMETER >= DIAMETER) THEN
            WRITE(MESSAGE,'(A,A)') 'KILL DIAMETER >= DIAMETER for particle class ',LPC%ID
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ENDIF
   ENDIF
   LPC%MONODISPERSE                     = MONODISPERSE
   LPC%PROP_ID                          = PROP_ID
   LPC%QUANTITIES                       = QUANTITIES
   LPC%QUANTITIES_SPEC_ID               = QUANTITIES_SPEC_ID
   LPC%GAMMA                            = GAMMA_D
   IF ( SIGMA_D > 0._EB ) THEN
      LPC%SIGMA                         = SIGMA_D
   ELSE
      LPC%SIGMA                         = 1.15_EB/GAMMA_D
   END IF
   LPC%DISTRIBUTION                     = DISTRIBUTION
   LPC%CHECK_DISTRIBUTION               = CHECK_DISTRIBUTION
   LPC%BREAKUP_DISTRIBUTION             = BREAKUP_DISTRIBUTION
   LPC%CNF_RAMP_ID                      = CNF_RAMP_ID
   LPC%BREAKUP_CNF_RAMP_ID              = BREAKUP_CNF_RAMP_ID

   IF(LPC%CNF_RAMP_ID/='null') THEN
        CALL GET_RAMP_INDEX(LPC%CNF_RAMP_ID,'DIAMETER',LPC%CNF_RAMP_INDEX)
   ENDIF
   IF(LPC%BREAKUP_CNF_RAMP_ID/='null') THEN
        CALL GET_RAMP_INDEX(LPC%BREAKUP_CNF_RAMP_ID,'DIAMETER',LPC%BREAKUP_CNF_RAMP_INDEX)
   ENDIF

   LPC%REAL_REFRACTIVE_INDEX = REAL_REFRACTIVE_INDEX
   LPC%COMPLEX_REFRACTIVE_INDEX = COMPLEX_REFRACTIVE_INDEX
   IF (LPC%REAL_REFRACTIVE_INDEX <= 0._EB .OR. LPC%COMPLEX_REFRACTIVE_INDEX < 0._EB) THEN
      WRITE(MESSAGE,'(A,A)') 'Bad refractive index on PART line ',LPC%ID
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   LPC%HEAT_OF_COMBUSTION = HEAT_OF_COMBUSTION*1000._EB
   LPC%FTPR               = FOTHPI*LPC%DENSITY
   LPC%LIFETIME           = AGE
   LPC%TURBULENT_DISPERSION = TURBULENT_DISPERSION
   LPC%STATIC             = STATIC
   LPC%SPEC_ID            = SPEC_ID
   LPC%SURF_ID            = SURF_ID
   LPC%SURF_INDEX         = -1
   LPC%SURFACE_DIAMETER   = SURFACE_DIAMETER*1.E-6_EB
   LPC%SURFACE_TENSION    = SURFACE_TENSION
   LPC%ADJUST_EVAPORATION  = 1._EB   ! If H_O_C>0. this parameter will have to be reset later
   LPC%MASS_TRANSFER_COEFFICIENT = MASS_TRANSFER_COEFFICIENT
   LPC%HEAT_TRANSFER_COEFFICIENT_GAS = HEAT_TRANSFER_COEFFICIENT_GAS
   LPC%HEAT_TRANSFER_COEFFICIENT_SOLID = HEAT_TRANSFER_COEFFICIENT_SOLID
   LPC%ADHERE_TO_SOLID     = ADHERE_TO_SOLID
   LPC%VERTICAL_VELOCITY   = VERTICAL_VELOCITY
   LPC%HORIZONTAL_VELOCITY = HORIZONTAL_VELOCITY
   LPC%DRAG_COEFFICIENT    = DRAG_COEFFICIENT
   LPC%SHAPE_FACTOR        = SHAPE_FACTOR
   LPC%EMBER_PARTICLE      = EMBER_PARTICLE
   LPC%EMBER_DENSITY_THRESHOLD = EMBER_DENSITY_THRESHOLD
   LPC%EMBER_VELOCITY_THRESHOLD = EMBER_VELOCITY_THRESHOLD
   LPC%PRIMARY_BREAKUP_TIME = PRIMARY_BREAKUP_LENGTH ! user enters LENGTH, later divide by PARTICLE_VELOCITY to get TIME
   LPC%PRIMARY_BREAKUP_DRAG_REDUCTION_FACTOR = PRIMARY_BREAKUP_DRAG_REDUCTION_FACTOR

   ! Count and process the number of orientations for the particle

   LPC%N_ORIENTATION = 0

   DO NN=1,10
      IF (ANY(ABS(ORIENTATION(1:3,NN))>TWO_EPSILON_EB)) LPC%N_ORIENTATION = LPC%N_ORIENTATION + 1
   ENDDO

   IF (LPC%N_ORIENTATION>0) THEN
      ALLOCATE(LPC%SOLID_ANGLE(1:LPC%N_ORIENTATION))
      LPC%SOLID_ANGLE = 4._EB*PI
      LPC%ORIENTATION_INDEX = N_ORIENTATION_VECTOR + 1
      DO NN=1,LPC%N_ORIENTATION
         OR_TEMP(1:3) = ORIENTATION(1:3,NN)
         N_ORIENTATION_VECTOR = N_ORIENTATION_VECTOR + 1
         IF (N_ORIENTATION_VECTOR>UBOUND(ORIENTATION_VECTOR,DIM=2)) THEN
            ORIENTATION_VECTOR => REALLOCATE2D(ORIENTATION_VECTOR,1,3,1,N_ORIENTATION_VECTOR+10)
         ENDIF
         IF (ALL(ABS(OR_TEMP(1:3))<TWO_EPSILON_EB)) THEN
            WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART line ',N,'.  All components of ORIENTATION are zero.'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         ORIENTATION_VECTOR(1:3,N_ORIENTATION_VECTOR) = ORIENTATION(1:3,NN)/ NORM2(OR_TEMP)
      ENDDO
   ENDIF
   LPC%FREE_AREA_FRACTION = FREE_AREA_FRACTION

   ! Drag laws

   IF (TRIM(DRAG_LAW)=='SCREEN' .AND. LPC%N_ORIENTATION/=1) THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART line ',N,'. Must specify exactly one ORIENTATION for SCREEN drag law.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (ANY(DRAG_COEFFICIENT>0._EB) .AND. (DRAG_LAW=='SPHERE' .OR.  DRAG_LAW=='CYLINDER')) THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART line ',N,'. Do not specify a DRAG_COEFFICIENT for a SPHERE or CYLINDER DRAG_LAW'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (DRAG_COEFFICIENT(1)>=0._EB .AND. DRAG_LAW=='null') DRAG_LAW = 'USER'

   SELECT CASE(DRAG_LAW)
      CASE('SPHERE','null')
         LPC%DRAG_LAW = SPHERE_DRAG
      CASE('CYLINDER')
         LPC%DRAG_LAW = CYLINDER_DRAG
      CASE('USER')
         LPC%DRAG_LAW = USER_DRAG
      CASE('SCREEN')
         LPC%DRAG_LAW = SCREEN_DRAG
         LPC%PERMEABILITY(1:3) = 3.44E-9_EB*LPC%FREE_AREA_FRACTION**1.6_EB
         LPC%DRAG_COEFFICIENT(1:3) = 4.30E-2_EB*LPC%FREE_AREA_FRACTION**2.13_EB
      CASE('POROUS MEDIA')
         IF (ANY(DRAG_COEFFICIENT<TWO_EPSILON_EB) .OR. ANY(PERMEABILITY<TWO_EPSILON_EB)) THEN
            WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART line ',N,&
                                      '.  For POROUS MEDIA must specify all compoents for DRAG_COEFFICIENT and PERMIABILTIY.'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         LPC%DRAG_LAW = POROUS_DRAG
         LPC%PERMEABILITY = PERMEABILITY
         LPC%POROUS_VOLUME_FRACTION = POROUS_VOLUME_FRACTION
      CASE DEFAULT
         WRITE(MESSAGE,'(A)') 'ERROR: unrecognized drag law on PART line'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   END SELECT

   ! Determine the number of slots to create in the particle evaporation and radiation arrays

   IF (LPC%LIQUID_DROPLET .OR. LPC%SOLID_PARTICLE) THEN
      N_LP_ARRAY_INDICES = N_LP_ARRAY_INDICES + 1
      LPC%ARRAY_INDEX =  N_LP_ARRAY_INDICES
      LPC%RUNNING_AVERAGE_FACTOR = RUNNING_AVERAGE_FACTOR
      LPC%RUNNING_AVERAGE_FACTOR_WALL = RUNNING_AVERAGE_FACTOR_WALL
      IF (LPC%SOLID_PARTICLE .AND. RUNNING_AVERAGE_FACTOR<0._EB) LPC%RUNNING_AVERAGE_FACTOR = 0.0_EB
      IF (LPC%LIQUID_DROPLET .AND. RUNNING_AVERAGE_FACTOR<0._EB) LPC%RUNNING_AVERAGE_FACTOR = 0.5_EB
      IF (LPC%SOLID_PARTICLE .AND. RUNNING_AVERAGE_FACTOR_WALL<0._EB) LPC%RUNNING_AVERAGE_FACTOR_WALL = 0.0_EB
      IF (LPC%LIQUID_DROPLET .AND. RUNNING_AVERAGE_FACTOR_WALL<0._EB) LPC%RUNNING_AVERAGE_FACTOR_WALL = 0.5_EB
   ENDIF

ENDDO READ_PART_LOOP

! Allocate radiation arrays

PLOOP2: DO ILPC=1,N_LAGRANGIAN_CLASSES
   LPC=>LAGRANGIAN_PARTICLE_CLASS(ILPC)
   IF (LPC%LIQUID_DROPLET) THEN
      ALLOCATE(LPC%WQABS(0:MIE_NDG,1:NUMBER_SPECTRAL_BANDS))
      CALL ChkMemErr('INIT','WQABS',IZERO)
      LPC%WQABS = 0._EB
      ALLOCATE(LPC%WQSCA(0:MIE_NDG,1:NUMBER_SPECTRAL_BANDS))
      CALL ChkMemErr('INIT','WQSCA',IZERO)
      LPC%WQSCA = 0._EB
      ALLOCATE(LPC%R50(0:MIE_NDG))
      CALL ChkMemErr('INIT','R50',IZERO)
      LPC%R50 = 0._EB
   ENDIF
ENDDO PLOOP2

! Determine output quantities

DO ILPC=1,N_LAGRANGIAN_CLASSES
   LPC=>LAGRANGIAN_PARTICLE_CLASS(ILPC)
   LPC%N_QUANTITIES = 0
   IF (ANY(LPC%QUANTITIES/='null')) THEN
      QUANTITIES_LOOP: DO N=1,10
         IF (LPC%QUANTITIES(N)=='null') CYCLE QUANTITIES_LOOP
         LPC%N_QUANTITIES = LPC%N_QUANTITIES + 1
         CALL GET_QUANTITY_INDEX(LPC%SMOKEVIEW_LABEL(LPC%N_QUANTITIES),LPC%SMOKEVIEW_BAR_LABEL(LPC%N_QUANTITIES), &
                                 LPC%QUANTITIES_INDEX(LPC%N_QUANTITIES),I_DUM(1), &
                                 LPC%QUANTITIES_Y_INDEX(LPC%N_QUANTITIES),LPC%QUANTITIES_Z_INDEX(LPC%N_QUANTITIES),&
                                 I_DUM(4),I_DUM(5),I_DUM(6),I_DUM(7),I_DUM(8),'PART', &
                                 LPC%QUANTITIES(N),'null',LPC%QUANTITIES_SPEC_ID(N),'null','null','null','null','null',&
                                 -1._EB,I_DUM(9))
      ENDDO QUANTITIES_LOOP
   ENDIF
ENDDO

CONTAINS


SUBROUTINE SET_PART_DEFAULTS

BREAKUP                  = .FALSE.
BREAKUP_RATIO            = 3._EB/7._EB  ! ratio of child Sauter mean to parent size in Bag breakup regime
BREAKUP_GAMMA_D          = 2.4_EB
BREAKUP_SIGMA_D          = -99999.9_EB
CTRL_ID                  = 'null'
DENSE_VOLUME_FRACTION    = 1.E-5_EB     ! Limiting volume fraction for drag reduction
DEVC_ID                  = 'null'
INITIAL_TEMPERATURE      = -TMPM - 1._EB
MASS_TRANSFER_COEFFICIENT = -1._EB   ! kg/m2/s
HEAT_TRANSFER_COEFFICIENT_GAS = -1._EB   ! W/m2/K
HEAT_TRANSFER_COEFFICIENT_SOLID = 300._EB   ! W/m2/K
HEAT_OF_COMBUSTION       = -1._EB       ! kJ/kg
DIAMETER                 = -1._EB
MAXIMUM_DIAMETER         = 1.E9_EB      ! microns, sets the largest particle generated when using a size distribution
MINIMUM_DIAMETER         = -1._EB       ! microns, sets the smallest particle generated when using a size distribution
KILL_DIAMETER            = -1._EB       ! microns, sets the diameter where a particle is killed
MONODISPERSE             = .FALSE.
N_STRATA                 = 6
GAMMA_D                  = 2.4_EB
SIGMA_D                  = -99999.9_EB
AGE                      = 1.E6_EB      ! s
ID                       = 'null'
PROP_ID                  = 'null'
ORIENTATION              = 0._EB
QUANTITIES               = 'null'
QUANTITIES_SPEC_ID       = 'null'
RADIATIVE_PROPERTY_TABLE = 'null'
RGB                      = -1
SPEC_ID                  = 'null'
SURF_ID                  = 'null'
SURFACE_DIAMETER         = 1000._EB
SURFACE_TENSION          = 72.8E-3_EB  ! N/m, applies for water
COLOR                    = 'null'
SAMPLING_FACTOR          = -1
STATIC                   = .FALSE.
MASSLESS                 = .FALSE.
TARGET_ONLY              = .FALSE.
TURBULENT_DISPERSION     = .FALSE.
REAL_REFRACTIVE_INDEX    = 1.33_EB
RUNNING_AVERAGE_FACTOR   = -1._EB
RUNNING_AVERAGE_FACTOR_WALL = -1._EB
COMPLEX_REFRACTIVE_INDEX = 0.01_EB
ADHERE_TO_SOLID          = .FALSE.
VERTICAL_VELOCITY        = 0.5_EB
HORIZONTAL_VELOCITY      = 0.2_EB
DRAG_LAW                 = 'null'
DRAG_COEFFICIENT         = -1._EB
PERMEABILITY             = -1._EB
DISTRIBUTION             = 'ROSIN-RAMMLER-LOGNORMAL'
CNF_RAMP_ID              = 'null'
CHECK_DISTRIBUTION       = .FALSE.
BREAKUP_DISTRIBUTION     = 'ROSIN-RAMMLER-LOGNORMAL'
BREAKUP_CNF_RAMP_ID      = 'null'
FREE_AREA_FRACTION       = 0.5_EB
SHAPE_FACTOR             = -1._EB
EMBER_PARTICLE           = .FALSE.
EMBER_DENSITY_THRESHOLD  = 0._EB
EMBER_VELOCITY_THRESHOLD = 1000._EB
PRIMARY_BREAKUP_LENGTH   = -1._EB
PRIMARY_BREAKUP_DRAG_REDUCTION_FACTOR = 1._EB

END SUBROUTINE SET_PART_DEFAULTS

END SUBROUTINE READ_PART


SUBROUTINE PROC_PART

USE PROPERTY_DATA, ONLY: JANAF_TABLE_LIQUID
USE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP
INTEGER :: N,NN,J,ITMP,I_MELT,I_BOIL
REAL(EB) :: H_L,H_V,CPBAR,H_G_S,H_G_S_REF,H_L_REF,TMP_REF,TMP_MELT,TMP_V,TMP_WGT,DENSITY,MASS,VOLUME,R_O,R_I,&
            MU_LIQUID,K_LIQUID,BETA_LIQUID
TYPE(LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC=>NULL()
TYPE(SPECIES_TYPE),POINTER:: SS=>NULL()
TYPE(SURFACE_TYPE),POINTER:: SF=>NULL()

IF (N_LAGRANGIAN_CLASSES == 0) RETURN

PART_LOOP: DO N=1,N_LAGRANGIAN_CLASSES

   LPC => LAGRANGIAN_PARTICLE_CLASS(N)
   SF  => SURFACE(LPC%SURF_INDEX)

   ! Assign device or controller

   CALL SEARCH_CONTROLLER('PART',LPC%CTRL_ID,LPC%DEVC_ID,LPC%DEVC_INDEX,LPC%CTRL_INDEX,N)

   ! Get density if the particles are liquid droplets or have mass

   IF (LPC%LIQUID_DROPLET) THEN
      CALL JANAF_TABLE_LIQUID (1,CPBAR,H_V,H_L,TMP_REF,TMP_MELT,TMP_V,SPECIES(LPC%Y_INDEX)%ID,LPC%FUEL,DENSITY,&
                               MU_LIQUID,K_LIQUID,BETA_LIQUID)
      IF (LPC%DENSITY < 0._EB) THEN
         LPC%DENSITY = DENSITY
         LPC%FTPR = FOTH*PI*DENSITY
         IF (SPECIES(LPC%Y_INDEX)%DENSITY_LIQUID<0._EB) SPECIES(LPC%Y_INDEX)%DENSITY_LIQUID = DENSITY
      ENDIF
      IF (SPECIES(LPC%Y_INDEX)%MU_LIQUID < 0._EB) SPECIES(LPC%Y_INDEX)%MU_LIQUID = MU_LIQUID
      IF (SPECIES(LPC%Y_INDEX)%K_LIQUID < 0._EB) SPECIES(LPC%Y_INDEX)%K_LIQUID = K_LIQUID
      IF (SPECIES(LPC%Y_INDEX)%BETA_LIQUID < 0._EB) SPECIES(LPC%Y_INDEX)%BETA_LIQUID = BETA_LIQUID
   ENDIF

   IF (SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN
      MASS = 0._EB
      VOLUME = 0._EB
      DO NN=1,SF%N_CELLS_INI
         SELECT CASE (SF%GEOMETRY)
            CASE (SURF_CARTESIAN)
               MASS = MASS + (SF%X_S(NN)-SF%X_S(NN-1))*SUM(SF%RHO_0(NN,1:SF%N_MATL))
               VOLUME = VOLUME + (SF%X_S(NN)-SF%X_S(NN-1))
            CASE (SURF_CYLINDRICAL)
               R_I = SF%INNER_RADIUS + SF%THICKNESS - SF%X_S(NN)
               R_O = SF%INNER_RADIUS + SF%THICKNESS - SF%X_S(NN-1)
               MASS   = MASS   + (R_O**2-R_I**2)*SUM(SF%RHO_0(NN,1:SF%N_MATL))
               VOLUME = VOLUME + (R_O**2-R_I**2)
            CASE (SURF_SPHERICAL)
               R_I = SF%INNER_RADIUS + SF%THICKNESS - SF%X_S(NN)
               R_O = SF%INNER_RADIUS + SF%THICKNESS - SF%X_S(NN-1)
               MASS   = MASS   + (R_O**3-R_I**3)*SUM(SF%RHO_0(NN,1:SF%N_MATL))
               VOLUME = VOLUME + (R_O**3-R_I**3)
         END SELECT
      ENDDO
      LPC%KILL_RADIUS = SF%MINIMUM_LAYER_THICKNESS
      LPC%DENSITY = MASS/VOLUME
      LPC%FTPR = FOTH*PI*LPC%DENSITY
   ENDIF

   ! Exclude some convective heat transfer models from being applied to a particle

   IF (SF%HEAT_TRANSFER_MODEL==LOGLAW_HTC_MODEL .OR. SF%HEAT_TRANSFER_MODEL==ABL_HTC_MODEL) THEN
      CALL SHUTDOWN('ERROR: HEAT_TRANSFER_MODEL not appropriate for PART')
      RETURN
   ENDIF

   ! Set the flag to do particle exchanges between meshes

   OMESH_PARTICLES=.TRUE.

   ! Only process DROPLETs

   SURF_OR_SPEC: IF (LPC%SURF_INDEX==DROPLET_SURF_INDEX) THEN

      SS => SPECIES(LPC%Y_INDEX)

      IZERO = 0
      IF (ALLOCATED(SS%C_P_L)) CYCLE PART_LOOP
      ALLOCATE(SS%C_P_L(0:5000),STAT=IZERO)
      CALL ChkMemErr('PROC_PART','SS%C_P_L',IZERO)
      SS%C_P_L=SS%SPECIFIC_HEAT_LIQUID
      ALLOCATE(SS%C_P_L_BAR(0:5000),STAT=IZERO)
      CALL ChkMemErr('PROC_PART','SS%C_P_L_BAR',IZERO)
      ALLOCATE(SS%H_L(0:5000),STAT=IZERO)
      CALL ChkMemErr('PROC_PART','SS%H_L',IZERO)
      ALLOCATE(SS%H_V(0:5000),STAT=IZERO)
      CALL ChkMemErr('PROC_PART','SS%H_V',IZERO)

      TMP_REF = -1._EB
      TMP_MELT = -1._EB
      TMP_V = -1._EB
      DO J = 1, 5000
         IF (SS%C_P_L(J) > 0._EB) THEN
            SS%H_L(J) = (REAL(J,EB)-SS%TMP_MELT)*SS%C_P_L(J)
            IF (J==1) THEN
               CALL JANAF_TABLE_LIQUID (J,CPBAR,H_V,H_L,TMP_REF,TMP_MELT,TMP_V,SS%PROP_ID,LPC%FUEL,DENSITY,&
                                        MU_LIQUID,K_LIQUID,BETA_LIQUID)
               IF (SS%H_V_REFERENCE_TEMPERATURE < 0._EB) SS%H_V_REFERENCE_TEMPERATURE=TMP_REF
               IF (SS%TMP_V < 0._EB) SS%TMP_V = TMP_V
               IF (SS%TMP_V < 0._EB) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: SPEC ',TRIM(SS%ID),' requires a VAPORIZATION_TEMPERATURE'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               IF (SS%TMP_MELT < 0._EB) SS%TMP_MELT = TMP_MELT
               IF (SS%TMP_MELT < 0._EB) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: PARTicle class ',TRIM(SS%ID),' requires a TMP_MELT'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               IF (LPC%DENSITY < 0._EB) LPC%DENSITY = DENSITY
               IF (LPC%DENSITY < 0._EB) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: PARTicle class ',TRIM(SS%ID),' requires a density'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               LPC%FTPR = FOTH*PI*LPC%DENSITY
            ENDIF
         ELSE
            CALL JANAF_TABLE_LIQUID (J,SS%C_P_L(J),H_V,H_L,TMP_REF,TMP_MELT,TMP_V,SS%ID,LPC%FUEL,DENSITY,&
                                     MU_LIQUID,K_LIQUID,BETA_LIQUID)
            IF (SS%RAMP_CP_L_INDEX>0) SS%C_P_L(J) = EVALUATE_RAMP(REAL(J,EB),1._EB,SS%RAMP_CP_L_INDEX)*1000._EB
            IF (J==1) THEN
               IF (SS%H_V_REFERENCE_TEMPERATURE < 0._EB) SS%H_V_REFERENCE_TEMPERATURE=TMP_REF
               IF (SS%TMP_V < 0._EB) SS%TMP_V = TMP_V
               IF (SS%TMP_V < 0._EB) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: PARTicle class ',TRIM(SS%ID),' requires a TMP_V'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               IF (SS%TMP_MELT < 0._EB) SS%TMP_MELT = TMP_MELT
               IF (SS%TMP_MELT < 0._EB) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: PARTicle class ',TRIM(SS%ID),' requires a TMP_MELT'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               IF (LPC%DENSITY < 0._EB) LPC%DENSITY = DENSITY
               IF (LPC%DENSITY < 0._EB) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: PARTicle class ',TRIM(SS%ID),' requires a density'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               LPC%FTPR = FOTH*PI*LPC%DENSITY
               IF (SS%C_P_L(J) < 0._EB) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: PARTicle class ',TRIM(SS%ID),' requires CP, H_V, TMP_MELT, TMP_V, and T_REF'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               SS%H_L(J) = H_L + SS%C_P_L(J)
            ELSE
               SS%H_L(J) = SS%H_L(J-1) + 0.5_EB*(SS%C_P_L(J)+SS%C_P_L(J-1))
            ENDIF
         ENDIF
      END DO

      SS%C_P_L(0) = SS%C_P_L(1)
      SS%H_L(0) = SS%H_L(1) - SS%C_P_L(1)

      ! Adjust liquid H_L to force H_V at H_V_REFERENCE_TEMPERATURE

      IF(SS%HEAT_OF_VAPORIZATION > 0._EB) H_V = SS%HEAT_OF_VAPORIZATION
      ITMP = INT(SS%H_V_REFERENCE_TEMPERATURE)
      TMP_WGT  = SS%H_V_REFERENCE_TEMPERATURE - REAL(ITMP,EB)
      H_L_REF = SS%H_L(ITMP)+TMP_WGT*(SS%H_L(ITMP+1)-SS%H_L(ITMP))
      H_G_S_REF=(CPBAR_Z(ITMP,LPC%Z_INDEX)+TMP_WGT*(CPBAR_Z(ITMP+1,LPC%Z_INDEX)-CPBAR_Z(ITMP,LPC%Z_INDEX)))*&
               SS%H_V_REFERENCE_TEMPERATURE
      SS%H_L = SS%H_L + (H_G_S_REF - H_L_REF) - H_V
      I_MELT = INT(SS%TMP_MELT) - 1
      I_BOIL = INT(SS%TMP_V) + 1

      ! Determine the properties of the PARTICLE

      DO J=1,5000
         H_G_S = CPBAR_Z(J,LPC%Z_INDEX)*REAL(J,EB)
         SS%H_V(J) = H_G_S - SS%H_L(J)
         IF (SS%H_V(J) < 0._EB .AND. J > I_MELT .AND. J < I_BOIL) THEN
             WRITE(MESSAGE,'(A,A,A)') 'ERROR: PARTicle class ',TRIM(SS%ID), ' H_V(T) < 0.  Check inputs for C_P gas and C_P liquid'
             CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (J==1) THEN
            SS%C_P_L_BAR(J) =  SS%H_L(J)
         ELSE
            SS%C_P_L_BAR(J) = SS%H_L(J) / REAL(J,EB)
         ENDIF
      ENDDO

      SS%H_V(0) = SS%H_V(1)
      SS%C_P_L_BAR(0) = SS%H_L(1)
      TMPMIN = MIN(TMPMIN,SS%TMP_MELT)

      SS%PR_LIQUID = SS%MU_LIQUID*SS%C_P_L(NINT(TMPA))/SS%K_LIQUID

   ENDIF SURF_OR_SPEC

! Adjust the evaporation rate of fuel PARTICLEs to account for difference in HoC.
   IF (LPC%HEAT_OF_COMBUSTION > 0._EB) THEN
      REAC_DO: DO NN=1,N_REACTIONS
         IF (TRIM(SPECIES_MIXTURE(LPC%Z_INDEX)%ID) == TRIM(REACTION(NN)%FUEL)) THEN
            LPC%ADJUST_EVAPORATION = LPC%HEAT_OF_COMBUSTION/REACTION(NN)%HOC_COMPLETE
            EXIT REAC_DO
         ENDIF
      ENDDO REAC_DO
   ENDIF

ENDDO PART_LOOP

END SUBROUTINE PROC_PART


SUBROUTINE READ_PROP

USE DEVICE_VARIABLES
USE MATH_FUNCTIONS, ONLY : GET_RAMP_INDEX,GET_TABLE_INDEX
USE PHYSICAL_FUNCTIONS, ONLY : SPRAY_ANGLE_DISTRIBUTION
REAL(EB) :: ACTIVATION_OBSCURATION,ACTIVATION_TEMPERATURE,ALPHA_C,ALPHA_E,BETA_C,BETA_E, &
            BEAD_DIAMETER,BEAD_EMISSIVITY,BEAD_SPECIFIC_HEAT,BEAD_DENSITY, &
            BEAD_HEAT_TRANSFER_COEFFICIENT,HEAT_TRANSFER_COEFFICIENT,DIAMETER,DENSITY,SPECIFIC_HEAT, &
            C_FACTOR,CHARACTERISTIC_VELOCITY,ORIFICE_DIAMETER,DROPLET_VELOCITY,EMISSIVITY, &
            PARTICLE_VELOCITY,FLOW_RATE,FLOW_TAU,GAUGE_EMISSIVITY,GAUGE_TEMPERATURE,INITIAL_TEMPERATURE,K_FACTOR,&
            LENGTH,SPRAY_ANGLE(2,2),OFFSET,OPERATING_PRESSURE,RTI,PDPA_START,PDPA_END,PDPA_RADIUS,MASS_FLOW_RATE,&
            SPRAY_PATTERN_MU,SPRAY_PATTERN_BETA,HISTOGRAM_LIMITS(2),P0,PX(3),PXX(3,3)
EQUIVALENCE(PARTICLE_VELOCITY,DROPLET_VELOCITY)
EQUIVALENCE(EMISSIVITY,BEAD_EMISSIVITY)
EQUIVALENCE(HEAT_TRANSFER_COEFFICIENT,BEAD_HEAT_TRANSFER_COEFFICIENT)
EQUIVALENCE(DENSITY,BEAD_DENSITY)
EQUIVALENCE(DIAMETER,BEAD_DIAMETER)
EQUIVALENCE(SPECIFIC_HEAT,BEAD_SPECIFIC_HEAT)
INTEGER ::I,N,NN,PDPA_M,PDPA_N,PARTICLES_PER_SECOND,VELOCITY_COMPONENT,HISTOGRAM_NBINS,FED_ACTIVITY
LOGICAL :: PDPA_INTEGRATE,PDPA_NORMALIZE,HISTOGRAM_NORMALIZE,HISTOGRAM,HISTOGRAM_CUMULATIVE
EQUIVALENCE(LENGTH,ALPHA_C)
CHARACTER(LABEL_LENGTH) :: SMOKEVIEW_ID(SMOKEVIEW_OBJECTS_DIMENSION),QUANTITY='null',PART_ID='null',FLOW_RAMP='null', &
                 SPRAY_PATTERN_TABLE='null',SPEC_ID='null',&
                 PRESSURE_RAMP='null',SMOKEVIEW_PARAMETERS(SMOKEVIEW_OBJECTS_DIMENSION), &
                 SPRAY_PATTERN_SHAPE='GAUSSIAN'
TYPE (PROPERTY_TYPE), POINTER :: PY=>NULL()

NAMELIST /PROP/ ACTIVATION_OBSCURATION,ACTIVATION_TEMPERATURE,ALPHA_C,ALPHA_E,BETA_C,BETA_E, &
                CHARACTERISTIC_VELOCITY,C_FACTOR,DENSITY,DIAMETER,EMISSIVITY,FED_ACTIVITY,FLOW_RAMP,FLOW_RATE,FLOW_TAU, &
                GAUGE_EMISSIVITY,GAUGE_TEMPERATURE,HEAT_TRANSFER_COEFFICIENT,HISTOGRAM,HISTOGRAM_CUMULATIVE, &
                HISTOGRAM_LIMITS,HISTOGRAM_NBINS,HISTOGRAM_NORMALIZE,ID, &
                INITIAL_TEMPERATURE,K_FACTOR,LENGTH,MASS_FLOW_RATE,OFFSET,OPERATING_PRESSURE,ORIFICE_DIAMETER,P0,&
                PARTICLES_PER_SECOND,PARTICLE_VELOCITY,PART_ID,PDPA_END,&
                PDPA_INTEGRATE,PDPA_M,PDPA_N,PDPA_NORMALIZE,PDPA_RADIUS,&
                PDPA_START,PRESSURE_RAMP,PX,PXX,QUANTITY,RTI,SMOKEVIEW_ID,SMOKEVIEW_PARAMETERS,SPEC_ID,SPECIFIC_HEAT,SPRAY_ANGLE,&
                SPRAY_PATTERN_BETA,SPRAY_PATTERN_MU,SPRAY_PATTERN_SHAPE,SPRAY_PATTERN_TABLE,VELOCITY_COMPONENT,&
                BEAD_EMISSIVITY,BEAD_HEAT_TRANSFER_COEFFICIENT,DROPLET_VELOCITY,& ! Backward compatability
                BEAD_DENSITY,BEAD_DIAMETER,BEAD_SPECIFIC_HEAT                     ! Backward compatability

! Count the PROP lines in the input file. Note how many of these are cables.

N_PROP=0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_PROP_LOOP: DO
   CALL CHECKREAD('PROP',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_PROP_LOOP
   READ(LU_INPUT,PROP,ERR=34,IOSTAT=IOS)
   N_PROP = N_PROP + 1
   34 IF (IOS>0) THEN
         WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with PROP number', N_PROP+1,', line number',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
ENDDO COUNT_PROP_LOOP

! Allocate the PROPERTY derived types

ALLOCATE(PROPERTY(0:N_PROP),STAT=IZERO)
CALL ChkMemErr('READ','PROPERTY',IZERO)

! Read the PROP lines in the order listed in the input file

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

READ_PROP_LOOP: DO N=0,N_PROP

   CALL CHECKREAD('PROP',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   CALL SET_PROP_DEFAULTS          ! Reset PROP NAMELIST parameters to default values
   IF (N > 0) READ(LU_INPUT,PROP)

   ! Pack PROP parameters into the appropriate property derived types

   PY => PROPERTY(N)
   PY%ACTIVATION_OBSCURATION   = ACTIVATION_OBSCURATION
   PY%ACTIVATION_TEMPERATURE   = ACTIVATION_TEMPERATURE   ! NOTE: Act_Temp remains in degrees C. It is just a SETPOINT.
   PY%ALPHA_C                  = ALPHA_C
   PY%ALPHA_E                  = ALPHA_E
   PY%BETA_C                   = BETA_C
   PY%BETA_E                   = BETA_E
   PY%DENSITY                  = DENSITY
   PY%DIAMETER                 = DIAMETER
   PY%EMISSIVITY               = EMISSIVITY
   PY%HEAT_TRANSFER_COEFFICIENT= HEAT_TRANSFER_COEFFICIENT
   PY%SPECIFIC_HEAT            = SPECIFIC_HEAT*1000._EB/TIME_SHRINK_FACTOR
   PY%C_FACTOR                 = C_FACTOR
   PY%CHARACTERISTIC_VELOCITY  = CHARACTERISTIC_VELOCITY
   PY%GAUGE_EMISSIVITY         = GAUGE_EMISSIVITY
   PY%GAUGE_TEMPERATURE        = GAUGE_TEMPERATURE + TMPM
   PY%ID                       = ID
   PY%INITIAL_TEMPERATURE      = INITIAL_TEMPERATURE + TMPM
   PY%PARTICLES_PER_SECOND     = PARTICLES_PER_SECOND
   PY%OFFSET                   = OFFSET
   PY%OPERATING_PRESSURE       = OPERATING_PRESSURE
   PY%PART_ID                  = PART_ID
   PY%QUANTITY                 = QUANTITY
   IF (PY%PART_ID/='null' .AND. PY%QUANTITY == 'null' ) PY%QUANTITY = 'NOZZLE FLOW RATE'
   PY%RTI                      = RTI
   IF (SMOKEVIEW_ID(1)/='null') THEN
      PY%SMOKEVIEW_ID          = SMOKEVIEW_ID
      PY%N_SMOKEVIEW_IDS = 0
      DO NN=1,SMOKEVIEW_OBJECTS_DIMENSION
         IF (SMOKEVIEW_ID(NN)/='null') PY%N_SMOKEVIEW_IDS = PY%N_SMOKEVIEW_IDS + 1
      ENDDO
   ELSE
      PY%N_SMOKEVIEW_IDS = 1
      SELECT CASE(PY%QUANTITY)
         CASE DEFAULT
            PY%SMOKEVIEW_ID(1) = 'sensor'
         CASE('SPRINKLER LINK TEMPERATURE')
            PY%SMOKEVIEW_ID(1) = 'sprinkler_pendent'
         CASE('NOZZLE FLOW RATE')
            PY%SMOKEVIEW_ID(1) = 'nozzle'
         CASE('LINK TEMPERATURE')
            PY%SMOKEVIEW_ID(1) = 'heat_detector'
         CASE('spot obscuration','CHAMBER OBSCURATION')
            PY%SMOKEVIEW_ID(1) = 'smoke_detector'
         CASE('THERMOCOUPLE')
            PY%SMOKEVIEW_ID(1) = 'thermocouple'
      END SELECT
   ENDIF
   PY%SMOKEVIEW_PARAMETERS = SMOKEVIEW_PARAMETERS
   PY%N_SMOKEVIEW_PARAMETERS = 0
   DO I=1,SMOKEVIEW_OBJECTS_DIMENSION
      IF (PY%SMOKEVIEW_PARAMETERS(I)/='null') PY%N_SMOKEVIEW_PARAMETERS = PY%N_SMOKEVIEW_PARAMETERS + 1
   ENDDO
   PY%SPEC_ID              = SPEC_ID
   IF (PART_ID/='null' .AND. SPRAY_PATTERN_TABLE /= 'null') THEN
      CALL GET_TABLE_INDEX(SPRAY_PATTERN_TABLE,SPRAY_PATTERN,PY%SPRAY_PATTERN_INDEX)
      PY%TABLE_ID = SPRAY_PATTERN_TABLE
   ELSE
      PY%SPRAY_PATTERN_INDEX = 0
   ENDIF
   PY%SPRAY_ANGLE = SPRAY_ANGLE*PI/180._EB
   IF(ANY(PY%SPRAY_ANGLE(1:2,2)<0)) PY%SPRAY_ANGLE(1:2,2)=PY%SPRAY_ANGLE(1:2,1)
   SPRAY_PATTERN_MU=SPRAY_PATTERN_MU*PI/180._EB
   IF (PART_ID/='null' .AND. SPRAY_PATTERN_TABLE == 'null' ) THEN
      ALLOCATE(PY%SPRAY_LON_CDF(0:NDC2),PY%SPRAY_LON(0:NDC2),PY%SPRAY_LAT(0:NDC2),PY%SPRAY_LAT_CDF(0:NDC2,0:NDC2))
      IF(SPRAY_PATTERN_MU<0._EB) THEN
         IF(SPRAY_ANGLE(1,1)>0._EB) THEN
            SPRAY_PATTERN_MU=0.5_EB*SUM(PY%SPRAY_ANGLE(1:2,1))
         ELSE
            SPRAY_PATTERN_MU=0._EB
         ENDIF
      ENDIF
      CALL SPRAY_ANGLE_DISTRIBUTION(PY%SPRAY_LON,PY%SPRAY_LAT,PY%SPRAY_LON_CDF,PY%SPRAY_LAT_CDF, &
                                      SPRAY_PATTERN_BETA,SPRAY_PATTERN_MU,PY%SPRAY_ANGLE &
                                      ,SPRAY_PATTERN_SHAPE,NDC2)
   ENDIF

   ! PDPA model

   PY%PDPA_START       = PDPA_START
   PY%PDPA_END         = PDPA_END
   PY%PDPA_RADIUS      = PDPA_RADIUS
   PY%PDPA_M           = PDPA_M
   PY%PDPA_N           = PDPA_N
   PY%PDPA_INTEGRATE   = PDPA_INTEGRATE
   PY%PDPA_NORMALIZE   = PDPA_NORMALIZE
   IF (TRIM(PY%QUANTITY) == 'NUMBER CONCENTRATION') THEN
      PY%PDPA_M        = 0
      PY%PDPA_N        = 0
   ENDIF
   IF ((TRIM(PY%QUANTITY) == 'MASS CONCENTRATION') .OR. &
       (TRIM(PY%QUANTITY) == 'ENTHALPY')           .OR. &
       (TRIM(PY%QUANTITY) == 'PARTICLE FLUX X')    .OR. &
       (TRIM(PY%QUANTITY) == 'PARTICLE FLUX Y')    .OR. &
       (TRIM(PY%QUANTITY) == 'PARTICLE FLUX Z')) THEN
      PY%PDPA_M        = 3
      PY%PDPA_N        = 0
   ENDIF

   ! Histograms

   PY%HISTOGRAM             = HISTOGRAM
   PY%HISTOGRAM_NBINS       = HISTOGRAM_NBINS
   PY%HISTOGRAM_LIMITS      = HISTOGRAM_LIMITS
   PY%HISTOGRAM_CUMULATIVE  = HISTOGRAM_CUMULATIVE
   PY%HISTOGRAM_NORMALIZE   = HISTOGRAM_NORMALIZE
   IF (HISTOGRAM) THEN
      IF (HISTOGRAM_NBINS<2) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: Problem with PROP ',TRIM(PY%ID),', HISTOGRAM needs HISTOGRAM_NBINS>2'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
       IF (ABS(HISTOGRAM_LIMITS(1)-HISTOGRAM_LIMITS(2)) < TWO_EPSILON_EB) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: Problem with PROP ',TRIM(PY%ID),', HISTOGRAM needs HISTOGRAM_LIMITS'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

   ENDIF

   PY%FED_ACTIVITY = FED_ACTIVITY
   IF(FED_ACTIVITY < 1 .OR. FED_ACTIVITY > 3) THEN
      WRITE(MESSAGE,'(A,A,A,I0)') 'ERROR: Problem with PROP ',TRIM(PY%ID),', FED_ACTIVITY out of range: ',FED_ACTIVITY
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   PATCH_VELOCITY_IF: IF (VELOCITY_COMPONENT>0) THEN
      IF(VELOCITY_COMPONENT > 3) THEN
         WRITE(MESSAGE,'(A,A,A,I0)') 'ERROR: Problem with PROP ',TRIM(PY%ID),', VELOCITY_COMPONENT > 3: ',VELOCITY_COMPONENT
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF(P0<-1.E9_EB) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: Problem with PROP ',TRIM(PY%ID),', VELOCITY_PATCH requires P0'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      PY%I_VEL = VELOCITY_COMPONENT
      PY%P0 = P0  ! value at origin of Taylor expansion
      DO J=1,3
         PY%PX(J) = PX(J)  ! first derivative of P evaluated at origin
         DO I=1,3
            IF (I>J) PXX(I,J)=PXX(J,I) ! make symmetric
            PY%PXX(I,J) = PXX(I,J) ! second derivative of P evaluated at origin
         ENDDO
      ENDDO
   ENDIF PATCH_VELOCITY_IF

   ! Set flow variables
   PY%MASS_FLOW_RATE =MASS_FLOW_RATE
   PY%FLOW_RATE      =FLOW_RATE

   IF (PART_ID/='null' .AND. PRESSURE_RAMP /= 'null') THEN
      CALL GET_RAMP_INDEX(PRESSURE_RAMP,'PRESSURE',PY%PRESSURE_RAMP_INDEX)
   ELSE
      PY%PRESSURE_RAMP_INDEX = 0
   ENDIF

   ! Check sufficient input

   IF (PY%PRESSURE_RAMP_INDEX == 0 .AND. FLOW_RATE > 0._EB) THEN
      IF (K_FACTOR < 0._EB) K_FACTOR = 10.0_EB
   ENDIF

   IF (PART_ID /='null' .AND. ABS(PDPA_RADIUS) <= TWO_EPSILON_EB) THEN
      IF (MASS_FLOW_RATE > 0._EB) THEN
         PY%MASS_FLOW_RATE = MASS_FLOW_RATE
         IF (ABS(PARTICLE_VELOCITY) <= TWO_EPSILON_EB) THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: Problem with PROP ',TRIM(PY%ID),', must specify PARTICLE_VELOCITY with MASS_FLOW_RATE'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ELSE
            PY%PARTICLE_VELOCITY  = PARTICLE_VELOCITY
         ENDIF
      ELSE
         IF ((FLOW_RATE>0._EB .AND. K_FACTOR<=0._EB .AND. OPERATING_PRESSURE<=0._EB) .OR. &
            (FLOW_RATE<0._EB .AND. K_FACTOR>=0._EB .AND. OPERATING_PRESSURE<=0._EB) .OR. &
            (FLOW_RATE<0._EB .AND. K_FACTOR<=0._EB .AND. OPERATING_PRESSURE>0._EB)) THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: Problem with PROP ',TRIM(PY%ID),', too few flow parameters'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (K_FACTOR < 0._EB .AND. OPERATING_PRESSURE > 0._EB)  K_FACTOR           = FLOW_RATE/SQRT(OPERATING_PRESSURE)
         IF (FLOW_RATE < 0._EB .AND. OPERATING_PRESSURE > 0._EB) FLOW_RATE          = K_FACTOR*SQRT(OPERATING_PRESSURE)
         IF (OPERATING_PRESSURE < 0._EB .AND. K_FACTOR > 0._EB)  OPERATING_PRESSURE = (FLOW_RATE/K_FACTOR)**2
         PY%K_FACTOR           = K_FACTOR
         PY%FLOW_RATE          = FLOW_RATE
         PY%OPERATING_PRESSURE = OPERATING_PRESSURE

         IF (PARTICLE_VELOCITY<=TWO_EPSILON_EB .AND. ORIFICE_DIAMETER<=TWO_EPSILON_EB .AND. &
            PRESSURE_RAMP=='null' .AND. SPRAY_PATTERN_TABLE=='null') THEN
            WRITE(MESSAGE,'(A,A,A)') 'WARNING: PROP ',TRIM(PY%ID),' PARTICLE velocity is not defined.'
            IF (MYID==0) WRITE(LU_ERR,'(A)') TRIM(MESSAGE)
         ENDIF

         IF (PARTICLE_VELOCITY > 0._EB) THEN
            PY%PARTICLE_VELOCITY  = PARTICLE_VELOCITY
         ELSEIF ((ORIFICE_DIAMETER > 0._EB) .AND. (FLOW_RATE > 0._EB)) THEN
            PY%PARTICLE_VELOCITY  = (FLOW_RATE/60._EB/1000._EB)/(PI*(ORIFICE_DIAMETER/2._EB)**2)
         ENDIF
      ENDIF
   ENDIF
   IF (FLOW_RAMP /= 'null') THEN
      CALL GET_RAMP_INDEX(FLOW_RAMP,'TIME',PY%FLOW_RAMP_INDEX)
   ELSE
      PY%FLOW_RAMP_INDEX = 0
   ENDIF
   IF (ABS(FLOW_TAU) > TWO_EPSILON_EB) THEN
      PY%FLOW_TAU = FLOW_TAU/TIME_SHRINK_FACTOR
      IF (FLOW_TAU > 0._EB) PY%FLOW_RAMP_INDEX = TANH_RAMP
      IF (FLOW_TAU < 0._EB) PY%FLOW_RAMP_INDEX = TSQR_RAMP
   ENDIF

   ! Check for SPEC_ID

   IF (PY%SPEC_ID/='null') THEN
      CALL GET_SPEC_OR_SMIX_INDEX(PY%SPEC_ID,PY%Y_INDEX,PY%Z_INDEX)
      IF (PY%Z_INDEX>=0 .AND. PY%Y_INDEX>=1) THEN
         IF (TRIM(PY%QUANTITY)=='DIFFUSIVITY') THEN
            PY%Y_INDEX=-999
         ELSE
            PY%Z_INDEX=-999
         ENDIF
      ENDIF
      IF (PY%Y_INDEX<1 .AND. PY%Z_INDEX<0) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: PROP SPEC_ID ',TRIM(PY%SPEC_ID),' not found'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF

ENDDO READ_PROP_LOOP


CONTAINS


SUBROUTINE SET_PROP_DEFAULTS

ACTIVATION_OBSCURATION   = 3.24_EB     ! %/m
ACTIVATION_TEMPERATURE   = -273.15_EB  ! C
ALPHA_C                  = 1.8_EB      ! m, Heskestad Length Scale
ALPHA_E                  = 0.0_EB
BETA_C                   = -1.0_EB
BETA_E                   = -1.0_EB
DENSITY                  = 8908._EB    ! kg/m3 (Nickel)
DIAMETER                 = 0.001       ! m
EMISSIVITY               = 0.85_EB
HEAT_TRANSFER_COEFFICIENT= -1._EB      ! W/m2/K
SPECIFIC_HEAT            = 0.44_EB     ! kJ/kg/K (Nickel)
C_FACTOR                 = 0.0_EB
CHARACTERISTIC_VELOCITY  = 1.0_EB      ! m/s
PARTICLE_VELOCITY         = 0._EB       ! m/s
PARTICLES_PER_SECOND      = 5000
FLOW_RATE                = -1._EB      ! L/min
MASS_FLOW_RATE           = -1._EB
FLOW_RAMP                = 'null'
FLOW_TAU                 = 0._EB
GAUGE_EMISSIVITY         = 1._EB
GAUGE_TEMPERATURE        = TMPA - TMPM
INITIAL_TEMPERATURE      = TMPA - TMPM
ID                       = 'null'
K_FACTOR                 = -1.0_EB     ! L/min/bar**0.5
MASS_FLOW_RATE           = -1._EB      ! kg/s
OFFSET                   = 0.05_EB     ! m
OPERATING_PRESSURE       = -1.0_EB     ! bar
ORIFICE_DIAMETER         = 0.0_EB      ! m
PART_ID                  = 'null'
PDPA_START               = T_BEGIN
PDPA_END                 = T_END + 1.0_EB
PDPA_RADIUS              = 0.0_EB
PDPA_M                   = 0
PDPA_N                   = 0
PDPA_INTEGRATE           = .TRUE.
PDPA_NORMALIZE           = .TRUE.
HISTOGRAM                = .FALSE.
HISTOGRAM_CUMULATIVE     = .FALSE.
HISTOGRAM_NBINS          = -1
HISTOGRAM_LIMITS         = 0._EB
HISTOGRAM_CUMULATIVE     = .FALSE.
HISTOGRAM_NORMALIZE      = .TRUE.
PRESSURE_RAMP            = 'null'
P0                       = -1.E10_EB
PX                       = 0._EB
PXX                      = 0._EB
QUANTITY                 = 'null'
RTI                      = 100._EB     ! (ms)**0.5
SMOKEVIEW_ID             = 'null'
SMOKEVIEW_PARAMETERS     = 'null'
SPEC_ID                  = 'null'
SPRAY_ANGLE(1,1)           = 60._EB      ! degrees
SPRAY_ANGLE(2,1)           = 75._EB      ! degrees
SPRAY_ANGLE(1,2)           = -999._EB      ! degrees
SPRAY_ANGLE(2,2)           = -999._EB      ! degrees
SPRAY_PATTERN_TABLE      = 'null'
SPRAY_PATTERN_SHAPE      = 'GAUSSIAN'
SPRAY_PATTERN_MU         = -1._EB
SPRAY_PATTERN_BETA       = 5.0_EB
FED_ACTIVITY             = 2 ! light work
VELOCITY_COMPONENT       = 0
END SUBROUTINE SET_PROP_DEFAULTS

END SUBROUTINE READ_PROP



SUBROUTINE PROC_PROP

USE DEVICE_VARIABLES
REAL(EB) :: TOTAL_FLOWRATE, SUBTOTAL_FLOWRATE
INTEGER :: N,NN,N_V_FACTORS,ILPC
LOGICAL :: TABLE_NORMED(1:N_TABLE)
TYPE (PROPERTY_TYPE), POINTER :: PY=>NULL()
TYPE (TABLES_TYPE),  POINTER :: TA=>NULL()
TYPE (LAGRANGIAN_PARTICLE_CLASS_TYPE),POINTER :: LPC=>NULL()

TABLE_NORMED = .FALSE.

PROP_LOOP: DO N=0,N_PROP
   PY => PROPERTY(N)

   ! Assign PART_INDEX to Device PROPERTY array

   IF (PY%PART_ID/='null') THEN

      DO ILPC=1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(ILPC)
         IF (LPC%ID==PY%PART_ID) THEN
            PY%PART_INDEX = ILPC
            EXIT
         ENDIF
      ENDDO

      IF (PY%PART_INDEX<0) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART_ID for PROP ',N,' not found'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (LPC%ID==PY%PART_ID .AND. LPC%MASSLESS_TRACER) THEN
         IF ( .NOT.(TRIM(PY%QUANTITY)=='NUMBER CONCENTRATION' .OR. &
                    TRIM(PY%QUANTITY)=='U-VELOCITY'           .OR. &
                    TRIM(PY%QUANTITY)=='V-VELOCITY'           .OR. &
                    TRIM(PY%QUANTITY)=='W-VELOCITY'           .OR. &
                    TRIM(PY%QUANTITY)=='VELOCITY')                 ) THEN
            WRITE(MESSAGE,'(A,I0,A)') 'ERROR: PART_ID for PROP ',N,' cannot refer to MASSLESS particles'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ENDIF

      PARTICLE_FILE=.TRUE.

      ! Initial nozzle velocity for primary breakup model

      IF (PY%PARTICLE_VELOCITY>TWO_EPSILON_EB) LPC%PRIMARY_BREAKUP_TIME = LPC%PRIMARY_BREAKUP_TIME/PY%PARTICLE_VELOCITY

   ENDIF

   ! Set up spinkler distributrion if needed

   IF (PY%SPRAY_PATTERN_INDEX > 0) THEN
      TA => TABLES(PY%SPRAY_PATTERN_INDEX)
      ALLOCATE(PY%TABLE_ROW(1:TA%NUMBER_ROWS))
      TOTAL_FLOWRATE=0._EB
      SUBTOTAL_FLOWRATE=0._EB
      DO NN=1,TA%NUMBER_ROWS
         IF (TA%TABLE_DATA(NN,6) <=0._EB) THEN
            WRITE(MESSAGE,'(A,A,A,I0)') 'ERROR: Spray Pattern Table, ',TRIM(PY%TABLE_ID),', massflux <= 0 for line ',NN
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         TOTAL_FLOWRATE = TOTAL_FLOWRATE + TA%TABLE_DATA(NN,6)
      ENDDO
      IF (TABLE_NORMED(PY%SPRAY_PATTERN_INDEX)) THEN
         DO NN=1,TA%NUMBER_ROWS
            SUBTOTAL_FLOWRATE = SUBTOTAL_FLOWRATE + TA%TABLE_DATA(NN,6)
            PY%TABLE_ROW(NN) = SUBTOTAL_FLOWRATE/TOTAL_FLOWRATE
         ENDDO
      ELSE
         DO NN=1,TA%NUMBER_ROWS
            TA%TABLE_DATA(NN,1) = TA%TABLE_DATA(NN,1) * PI/180._EB
            TA%TABLE_DATA(NN,2) = TA%TABLE_DATA(NN,2) * PI/180._EB
            TA%TABLE_DATA(NN,3) = TA%TABLE_DATA(NN,3) * PI/180._EB
            TA%TABLE_DATA(NN,4) = TA%TABLE_DATA(NN,4) * PI/180._EB
            SUBTOTAL_FLOWRATE = SUBTOTAL_FLOWRATE + TA%TABLE_DATA(NN,6)
            PY%TABLE_ROW(NN) = SUBTOTAL_FLOWRATE/TOTAL_FLOWRATE
         ENDDO
         TABLE_NORMED(PY%SPRAY_PATTERN_INDEX) = .TRUE.
      ENDIF
      PY%TABLE_ROW(TA%NUMBER_ROWS) = 1._EB
   END IF

   ! Set up pressure dependence

   IF (PY%PRESSURE_RAMP_INDEX > 0) THEN
      IF (PY%SPRAY_PATTERN_INDEX > 0) THEN
         N_V_FACTORS = TA%NUMBER_ROWS
      ELSE
         N_V_FACTORS = 1
      ENDIF
      ALLOCATE(PY%V_FACTOR(1:N_V_FACTORS))
      IF (PY%SPRAY_PATTERN_INDEX > 0) THEN
         DO NN=1,TA%NUMBER_ROWS
            PY%V_FACTOR(NN) = TA%TABLE_DATA(NN,5)/SQRT(PY%OPERATING_PRESSURE)
         ENDDO
      ELSE
         PY%V_FACTOR = PY%PARTICLE_VELOCITY/SQRT(PY%OPERATING_PRESSURE)
      ENDIF
   ENDIF

ENDDO PROP_LOOP

END SUBROUTINE PROC_PROP



SUBROUTINE READ_MATL

USE COMP_FUNCTIONS, ONLY : SEARCH_INPUT_FILE
USE MATH_FUNCTIONS, ONLY : GET_RAMP_INDEX
CHARACTER(LABEL_LENGTH) :: CONDUCTIVITY_RAMP,SPECIFIC_HEAT_RAMP,HEAT_OF_REACTION_RAMP(MAX_REACTIONS)
CHARACTER(LABEL_LENGTH) :: SPEC_ID(MAX_SPECIES,MAX_REACTIONS)
REAL(EB) :: EMISSIVITY,CONDUCTIVITY,SPECIFIC_HEAT,DENSITY,ABSORPTION_COEFFICIENT,BOILING_TEMPERATURE, &
            PEAK_REACTION_RATE,REFRACTIVE_INDEX,DIFFUSIVITY_SPEC(MAX_SPECIES)
REAL(EB), DIMENSION(MAX_MATERIALS,MAX_REACTIONS) :: NU_MATL,HEAT_OF_COMBUSTION
REAL(EB), DIMENSION(MAX_REACTIONS) :: A,E,HEATING_RATE,PYROLYSIS_RANGE,HEAT_OF_REACTION, &
          N_S,N_T,N_O2,REFERENCE_RATE,REFERENCE_TEMPERATURE,THRESHOLD_TEMPERATURE, &
          THRESHOLD_SIGN,GAS_DIFFUSION_DEPTH,NU_O2_CHAR,BETA_CHAR
REAL(EB) :: NU_SPEC(MAX_SPECIES,MAX_REACTIONS)
LOGICAL, DIMENSION(MAX_REACTIONS) :: PCR
LOGICAL :: ALLOW_SHRINKING, ALLOW_SWELLING,ADD_MATL,FOUND
CHARACTER(25) :: COLOR
INTEGER :: RGB(3)
CHARACTER(LABEL_LENGTH), DIMENSION(MAX_MATERIALS,MAX_REACTIONS) :: MATL_ID
CHARACTER(LABEL_LENGTH), ALLOCATABLE, DIMENSION(:) :: SEARCH_PHRASE,MATL_NAME_RESERVED
INTEGER :: N,NN,NNN,IOS,NR,N_REACTIONS,N_MATL_RESERVED,N_MATL_READ
NAMELIST /MATL/ A,ABSORPTION_COEFFICIENT,ALLOW_SHRINKING,ALLOW_SWELLING,BETA_CHAR,BOILING_TEMPERATURE,&
                COLOR,CONDUCTIVITY,CONDUCTIVITY_RAMP,DENSITY,DIFFUSIVITY_SPEC,E,EMISSIVITY,FYI,&
                GAS_DIFFUSION_DEPTH,HEATING_RATE,HEAT_OF_COMBUSTION,HEAT_OF_REACTION,HEAT_OF_REACTION_RAMP,ID,MATL_ID,&
                N_O2,N_REACTIONS,N_S,N_T,NU_MATL,NU_O2_CHAR,NU_SPEC,&
                PCR,PYROLYSIS_RANGE,REFERENCE_RATE,REFERENCE_TEMPERATURE,REFRACTIVE_INDEX,RGB,&
                SPECIFIC_HEAT,SPECIFIC_HEAT_RAMP,SPEC_ID,THRESHOLD_SIGN,THRESHOLD_TEMPERATURE

! Count the MATL lines in the input file

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
N_MATL = 0
COUNT_MATL_LOOP: DO
   CALL CHECKREAD('MATL',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_MATL_LOOP
   READ(LU_INPUT,MATL,ERR=34,IOSTAT=IOS)
   N_MATL = N_MATL + 1
   MATL_NAME(N_MATL) = ID
   34 IF (IOS>0) THEN
         WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with MATL number', N_MATL+1,', line number',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
ENDDO COUNT_MATL_LOOP

N_MATL_READ = N_MATL

! Add reserved materials if necessary

N_MATL_RESERVED = 2
ALLOCATE(SEARCH_PHRASE(N_MATL_RESERVED)) ; ALLOCATE(MATL_NAME_RESERVED(N_MATL_RESERVED))
SEARCH_PHRASE(1) = 'MOISTURE_FRACTION' ; MATL_NAME_RESERVED(1) = 'MOISTURE'
SEARCH_PHRASE(2) = 'PACKING_RATIO'     ; MATL_NAME_RESERVED(2) = 'AIR'

DO NN=1,N_MATL_RESERVED
   CALL SEARCH_INPUT_FILE(LU_INPUT,TRIM(SEARCH_PHRASE(NN)),FOUND)
   IF (FOUND) THEN
      ADD_MATL = .TRUE.
      DO N=1,N_MATL
         IF (MATL_NAME(N)==MATL_NAME_RESERVED(NN)) ADD_MATL = .FALSE.
      ENDDO
      IF (ADD_MATL) THEN
         N_MATL = N_MATL + 1
         MATL_NAME(N_MATL) = MATL_NAME_RESERVED(NN)
      ENDIF
   ENDIF
ENDDO

! Allocate the MATERIAL derived type

ALLOCATE(MATERIAL(1:N_MATL),STAT=IZERO)
CALL ChkMemErr('READ','MATERIAL',IZERO)

! Read the MATL lines in the order listed in the input file

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

READ_MATL_LOOP: DO N=1,N_MATL

   ML => MATERIAL(N)

   ! Read user defined MATL lines or reserved MATL's

   IF (N <= N_MATL_READ) THEN
      CALL CHECKREAD('MATL',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      CALL SET_MATL_DEFAULTS
      READ(LU_INPUT,MATL)
   ELSE
      CALL SET_MATL_DEFAULTS
      SELECT CASE(MATL_NAME(N))
         CASE('MOISTURE')
            ID                  = 'MOISTURE'
            DENSITY             = 1000._EB
            CONDUCTIVITY        = 0.62_EB
            SPECIFIC_HEAT       = 4.184_EB
            A(1)                = 600000._EB
            E(1)                = 48200._EB
            N_T(1)              = -0.5_EB
            SPEC_ID(1,1)        = 'WATER VAPOR'
            NU_SPEC(1,1)        = 1._EB
            HEAT_OF_REACTION(1) = 2259._EB
         CASE('AIR')
            ID               = 'AIR'
            DENSITY          = 1.2_EB
            CONDUCTIVITY     = 0.0026_EB  ! Artificially low value to retain the same diffusivity
            SPECIFIC_HEAT    = 0.1_EB     ! Artificially low value because AIR does not absorb heat in the BOUNDARY_FUEL_MODEL
      END SELECT
   ENDIF

   ! Do some error checking on the inputs

   NOT_BOILING: IF (BOILING_TEMPERATURE>4000._EB) THEN

      IF ( ( ANY(THRESHOLD_TEMPERATURE>-TMPM) .OR. ANY(REFERENCE_TEMPERATURE>-TMPM) .OR. ANY(A>=0._EB) .OR. ANY(E>=0._EB) .OR. &
             ANY(ABS(HEAT_OF_REACTION)>TWO_EPSILON_EB) ) .AND. N_REACTIONS==0) THEN
         N_REACTIONS = 1
      ENDIF

      DO NR=1,N_REACTIONS
         IF (REFERENCE_TEMPERATURE(NR)<-TMPM  .AND. (E(NR)< 0._EB .OR. A(NR)<0._EB)) THEN
            WRITE(MESSAGE,'(A,A,A,I0,A)') 'ERROR: Problem with MATL ',TRIM(ID),', REAC ',NR,'. Set REFERENCE_TEMPERATURE or E, A'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (ABS(SUM(NU_MATL(:,NR)))<=TWO_EPSILON_EB .AND. ABS(SUM(NU_SPEC(:,NR)))<=TWO_EPSILON_EB) THEN
            WRITE(MESSAGE,'(A,A,A,I0,A)') 'WARNING: MATL ',TRIM(ID),', REAC ',NR,'. No product yields (NUs) set'
            IF (MYID==0) WRITE(LU_ERR,'(A)') TRIM(MESSAGE)
         ENDIF
      ENDDO

   ELSE NOT_BOILING ! Is liquid

      N_REACTIONS = 1
      IF (ABS(HEAT_OF_REACTION(1))<=TWO_EPSILON_EB .AND. ML%RAMP_H_R(1)=='null') THEN
         WRITE(MESSAGE,'(A,A)') 'ERROR: HEAT_OF_REACTION should be greater than zero for liquid MATL ',TRIM(ID)
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

   ENDIF NOT_BOILING

   ! Error checking for thermal properties

   IF (ABS(DENSITY) <=TWO_EPSILON_EB ) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: Problem with MATL ',TRIM(ID),': DENSITY=0'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (ABS(CONDUCTIVITY) <=TWO_EPSILON_EB .AND. CONDUCTIVITY_RAMP == 'null' ) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: Problem with MATL ',TRIM(ID),': CONDUCTIVITY = 0'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (ABS(SPECIFIC_HEAT)<=TWO_EPSILON_EB .AND. SPECIFIC_HEAT_RAMP == 'null' ) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: Problem with MATL ',TRIM(ID),': SPECIFIC_HEAT = 0'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (SPECIFIC_HEAT > 10._EB) WRITE(LU_ERR,'(A,A)') 'WARNING: SPECIFIC_HEAT units are kJ/kg/K check MATL ',TRIM(ID)

   ! Pack MATL parameters into the MATERIAL derived type

   IF (COLOR/='null') THEN
      CALL COLOR2RGB(RGB,COLOR)
   ENDIF
   IF (ANY(RGB< 0)) THEN
      RGB(1) = 255
      RGB(2) = 204
      RGB(3) = 102
   ENDIF
   ML%RGB                  = RGB

   ML%A(:)                 = A(:)

   ALLOCATE(ML%ADJUST_BURN_RATE(N_TRACKED_SPECIES,MAX(1,N_REACTIONS)),STAT=IZERO)
   CALL ChkMemErr('READ','MATERIAL',IZERO)
   ML%ADJUST_BURN_RATE     = 1._EB
   ML%ALLOW_SHRINKING      = ALLOW_SHRINKING
   ML%ALLOW_SWELLING       = ALLOW_SWELLING
   ML%BETA_CHAR(:)         = BETA_CHAR(:)
   ML%C_S                  = 1000._EB*SPECIFIC_HEAT/TIME_SHRINK_FACTOR
   ML%DIFFUSIVITY_SPEC(:)  = DIFFUSIVITY_SPEC(:)
   ML%E(:)                 = 1000._EB*E(:)
   ML%EMISSIVITY           = EMISSIVITY
   ML%FYI                  = FYI
   ML%GAS_DIFFUSION_DEPTH(:) = GAS_DIFFUSION_DEPTH(:)
   ML%HEAT_OF_COMBUSTION   = 1000._EB*HEAT_OF_COMBUSTION
   ML%H_R(:)               = 1000._EB*HEAT_OF_REACTION(:)
   ML%ID                   = ID
   ML%KAPPA_S              = ABSORPTION_COEFFICIENT
   ML%K_S                  = CONDUCTIVITY
   ML%N_REACTIONS          = N_REACTIONS
   ML%N_O2(:)              = N_O2(:)
   ML%NU_O2_CHAR(:)        = NU_O2_CHAR(:)
   ML%N_S(:)               = N_S(:)
   ML%N_T(:)               = N_T(:)
   ML%NU_SPEC              = NU_SPEC
   ML%SPEC_ID              = SPEC_ID
   ML%RAMP_H_R             = HEAT_OF_REACTION_RAMP
   ML%RAMP_C_S             = SPECIFIC_HEAT_RAMP
   ML%RAMP_K_S             = CONDUCTIVITY_RAMP
   ML%RHO_S                = DENSITY      ! This is bulk density of pure material.
   ML%REFRACTIVE_INDEX     = REFRACTIVE_INDEX
   ML%RESIDUE_MATL_NAME    = MATL_ID
   ML%HEATING_RATE(:)      = HEATING_RATE(:)/60._EB
   ML%PYROLYSIS_RANGE(:)   = PYROLYSIS_RANGE(:)
   ML%PCR(:)               = PCR(:)
   ML%TMP_BOIL             = BOILING_TEMPERATURE + TMPM
   ML%TMP_THR(:)           = THRESHOLD_TEMPERATURE(:) + TMPM
   ML%TMP_REF(:)           = REFERENCE_TEMPERATURE(:) + TMPM
   ML%THR_SIGN(:)          = THRESHOLD_SIGN
   ML%RATE_REF(:)          = REFERENCE_RATE(:)

   ALLOCATE(ML%NU_GAS(N_TRACKED_SPECIES,N_REACTIONS),STAT=IZERO)
   CALL ChkMemErr('READ','MATERIAL',IZERO)
   ML%NU_GAS=0._EB

   ! Gas in solid diffusion coefficients

   ALLOCATE(ML%DIFFUSIVITY_GAS(N_TRACKED_SPECIES),STAT=IZERO)
   CALL ChkMemErr('READ','MATERIAL',IZERO)
   ML%DIFFUSIVITY_GAS=0._EB

   ! Additional logic

   IF (BOILING_TEMPERATURE<5000._EB) THEN
      ML%PYROLYSIS_MODEL = PYROLYSIS_LIQUID
      ML%N_REACTIONS = 1
   ELSEIF (ML%NU_O2_CHAR(1)>0._EB) THEN
      CHAR_OXIDATION     = .TRUE.
      WALL_INCREMENT     = 1  ! Do pyrolysis every time step
      ML%PYROLYSIS_MODEL = PYROLYSIS_VEGETATION
   ELSE
      ML%PYROLYSIS_MODEL = PYROLYSIS_SOLID
   ENDIF

   IF (N_REACTIONS==0) ML%PYROLYSIS_MODEL = PYROLYSIS_NONE

   IF (ANY(ML%RAMP_H_R/='null')) THEN
      DO NNN=1,MAX_REACTIONS
         IF (ML%RAMP_H_R(NNN)/='null') THEN
            CALL GET_RAMP_INDEX(ML%RAMP_H_R(NNN),'TEMPERATURE',NR)
            ML%H_R_I(NNN) = NR
         ENDIF
      ENDDO
   ENDIF

   IF (ML%RAMP_K_S/='null') THEN
      CALL GET_RAMP_INDEX(ML%RAMP_K_S,'TEMPERATURE',NR)
      ML%K_S = -NR
   ENDIF

   IF (ML%RAMP_C_S/='null') THEN
      CALL GET_RAMP_INDEX(ML%RAMP_C_S,'TEMPERATURE',NR)
      ML%C_S = -NR
   ENDIF

   ! Determine A and E if REFERENCE_TEMPERATURE is specified

   DO NR=1,ML%N_REACTIONS
      IF (ML%TMP_REF(NR) > 0._EB) THEN
         IF (ML%RATE_REF(NR) > 0._EB) THEN
            PEAK_REACTION_RATE = ML%RATE_REF(NR)
         ELSE
            PEAK_REACTION_RATE = 2._EB*ML%HEATING_RATE(NR)*(1._EB-SUM(NU_MATL(:,NR)))/ML%PYROLYSIS_RANGE(NR)
         ENDIF
         ML%E(NR) = EXP(1._EB)*PEAK_REACTION_RATE*R0*ML%TMP_REF(NR)**2/ML%HEATING_RATE(NR)
         ML%A(NR) = EXP(1._EB)*PEAK_REACTION_RATE*EXP(ML%E(NR)/(R0*ML%TMP_REF(NR)))
      ENDIF

      ML%N_RESIDUE(NR) = 0
      DO NN=1,MAX_MATERIALS
         IF (ML%RESIDUE_MATL_NAME(NN,NR)/='null') ML%N_RESIDUE(NR) = ML%N_RESIDUE(NR) + 1
         DO NNN=1,N_MATL
            IF (MATL_ID(NN,NR)==MATL_NAME(NNN)) ML%NU_RESIDUE(NNN,NR) = NU_MATL(NN,NR)
         ENDDO
      ENDDO
   ENDDO

ENDDO READ_MATL_LOOP

! Assign a material index to the RESIDUEs

DO N=1,N_MATL
   ML => MATERIAL(N)
   ML%RESIDUE_MATL_INDEX = 0
   DO NR=1,ML%N_REACTIONS
      DO NN=1,ML%N_RESIDUE(NR)
         DO NNN=1,N_MATL
            IF (MATL_NAME(NNN)==ML%RESIDUE_MATL_NAME(NN,NR)) ML%RESIDUE_MATL_INDEX(NN,NR) = NNN
         ENDDO
         IF (ML%RESIDUE_MATL_INDEX(NN,NR)==0) THEN
            WRITE(MESSAGE,'(5A)') 'ERROR: Residue ', TRIM(ML%RESIDUE_MATL_NAME(NN,NR)),' of ',TRIM(MATL_NAME(N)),' is not defined.'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ENDDO
   ENDDO
ENDDO

! Check for duplicate names

IF (N_MATL>1) THEN
   DO N=1,N_MATL-1
      DO NN=N+1,N_MATL
         IF(MATL_NAME(N)==MATL_NAME(NN)) THEN
            WRITE(MESSAGE,'(A,A)') 'ERROR: Duplicate material name: ',TRIM(MATL_NAME(N))
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ENDDO
   ENDDO
ENDIF

CONTAINS

SUBROUTINE SET_MATL_DEFAULTS

A                      = -1._EB      ! 1/s
ABSORPTION_COEFFICIENT = 5.0E4_EB    ! 1/m, corresponds to 99.3% drop within 1E-4 m distance.
ALLOW_SHRINKING        = .TRUE.
ALLOW_SWELLING         = .TRUE.
BOILING_TEMPERATURE    = 5000._EB    ! C
BETA_CHAR              = 0.2_EB
COLOR                  = 'null'
RGB                     = -1
CONDUCTIVITY           = 0.0_EB      ! W/m/K
CONDUCTIVITY_RAMP      = 'null'
DIFFUSIVITY_SPEC       = 0._EB       ! m2/s
DENSITY                = 0._EB       ! kg/m3
E                      = -1._EB      ! J/mol
EMISSIVITY             = 0.9_EB
FYI                    = 'null'
GAS_DIFFUSION_DEPTH    = 0.001_EB    ! m
HEAT_OF_COMBUSTION     = -1._EB      ! kJ/kg
HEAT_OF_REACTION       = 0._EB       ! kJ/kg
HEAT_OF_REACTION_RAMP  = 'null'
ID                     = 'null'
THRESHOLD_TEMPERATURE  = -TMPM       ! 0 K
THRESHOLD_SIGN         = 1.0
N_REACTIONS            = 0
N_O2                   = 0._EB
NU_O2_CHAR             = 0._EB
N_S                    = 1._EB
N_T                    = 0._EB
NU_SPEC                = 0._EB
NU_MATL                = 0._EB
PCR                    = .FALSE.
REFERENCE_RATE         = -1._EB
REFERENCE_TEMPERATURE  = -1000._EB
REFRACTIVE_INDEX       = 1._EB
MATL_ID                = 'null'
SPECIFIC_HEAT          = 0.0_EB      ! kJ/kg/K
SPECIFIC_HEAT_RAMP     = 'null'
SPEC_ID                = 'null'
HEATING_RATE           = 5._EB       ! K/min
PYROLYSIS_RANGE        = 80._EB      ! K or C

END SUBROUTINE SET_MATL_DEFAULTS

END SUBROUTINE READ_MATL



!> \brief Process solid phase material parameters and do some additional set-up work

SUBROUTINE PROC_MATL

USE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP
INTEGER :: I,N,NS,NS2,NR,NR2,Z_INDEX(N_TRACKED_SPECIES,MAX_REACTIONS)

PROC_MATL_LOOP: DO N=1,N_MATL

   ML => MATERIAL(N)

   ! Convert ML%NU_SPEC(I_ORDINAL,I_REACTION) and ML%SPEC_ID(I_ORDINAL,I_REACTION) to ML%NU_GAS(I_SPECIES,I_REACTION)

   Z_INDEX = -1
   IF (ML%N_REACTIONS==0 .AND. ML%HEAT_OF_COMBUSTION(1,1)>0._EB) &
      ML%ADJUST_BURN_RATE(REACTION(1)%FUEL_SMIX_INDEX,1) = ML%HEAT_OF_COMBUSTION(1,1) / REACTION(1)%HOC_COMPLETE
   DO NR=1,ML%N_REACTIONS
      DO NS=1,MAX_SPECIES

         IF (TRIM(ML%SPEC_ID(NS,NR))=='null' .AND. ML%NU_SPEC(NS,NR)>TWO_EPSILON_EB) THEN
            WRITE(MESSAGE,'(A,A,A,I0,A,I0)') 'ERROR: MATL ',TRIM(MATL_NAME(N)),' requires a SPEC_ID for yield ',&
                 NS, 'of reaction ', NR
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (TRIM(ML%SPEC_ID(NS,NR))=='null') EXIT
         IF (NS==2 .AND. ML%PYROLYSIS_MODEL==PYROLYSIS_LIQUID) THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: MATL ',TRIM(MATL_NAME(N)),' can only specify one SPEC_ID for a liquid'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         DO NS2=1,N_TRACKED_SPECIES
            IF (TRIM(ML%SPEC_ID(NS,NR))==TRIM(SPECIES_MIXTURE(NS2)%ID)) THEN
               Z_INDEX(NS,NR) = NS2
               ML%NU_GAS(Z_INDEX(NS,NR),NR) = ML%NU_SPEC(NS,NR)
               ML%DIFFUSIVITY_GAS(Z_INDEX(NS,NR)) = ML%DIFFUSIVITY_SPEC(NS)
               EXIT
            ENDIF
         ENDDO
         ! Adjust burn rate if heat of combustion is different from the gas phase reaction value
         IF (ML%HEAT_OF_COMBUSTION(NS,NR) > 0._EB) THEN
            REAC_DO: DO NR2 = 1,N_REACTIONS
               IF(TRIM(ML%SPEC_ID(NS,NR))==TRIM(REACTION(NR2)%FUEL) .AND. REACTION(NR2)%HOC_COMPLETE > 0._EB) THEN
                  ML%ADJUST_BURN_RATE(Z_INDEX(NS,NR),NR) = ML%HEAT_OF_COMBUSTION(NS,NR) / REACTION(NR2)%HOC_COMPLETE
                  EXIT REAC_DO
               ENDIF
            ENDDO REAC_DO
         ENDIF
         IF (Z_INDEX(NS,NR)==-1) THEN
            WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR: SPECies ',TRIM(ML%SPEC_ID(NS,NR)),&
                                         ' corresponding to MATL ',TRIM(MATL_NAME(N)),' is not a tracked species'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ENDDO
   ENDDO

   ! Check units of specific heat

   IF (ML%RAMP_C_S/='null') THEN
      NR = -NINT(ML%C_S)
      IF (.NOT.RAMPS(NR)%DEP_VAR_UNITS_CONVERTED) THEN
         RAMPS(NR)%INTERPOLATED_DATA(:) = RAMPS(NR)%INTERPOLATED_DATA(:)*1000._EB/TIME_SHRINK_FACTOR
         RAMPS(NR)%DEP_VAR_UNITS_CONVERTED = .TRUE.
      ENDIF
      IF (RAMPS(NR)%DEPENDENT_DATA(1) > 10._EB) &
         WRITE(LU_ERR,'(A,A)') 'WARNING: SPECIFIC_HEAT units are kJ/kg/K check MATL ',TRIM(ID)
   ENDIF

   ! Check units of heat of reaction

   DO NR=1,ML%N_REACTIONS
      IF (ML%H_R_I(NR)>0) THEN
         IF (.NOT.RAMPS(ML%H_R_I(NR))%DEP_VAR_UNITS_CONVERTED) THEN
            RAMPS(ML%H_R_I(NR))%INTERPOLATED_DATA(:) = RAMPS(ML%H_R_I(NR))%INTERPOLATED_DATA(:)*1000._EB
            RAMPS(ML%H_R_I(NR))%DEP_VAR_UNITS_CONVERTED = .TRUE.
         ENDIF
      ENDIF
   ENDDO

   DO I=1,5000
       IF (ML%C_S>0._EB) THEN
         ML%H(I) = ML%H(I-1) + ML%C_S
      ELSE
         NR = -NINT(ML%C_S)
         ML%H(I) = ML%H(I-1) + EVALUATE_RAMP(REAL(I,EB),0._EB,NR)
      ENDIF
  ENDDO

ENDDO PROC_MATL_LOOP

END SUBROUTINE PROC_MATL


!> \brief Read the SURF namelist lines

SUBROUTINE READ_SURF

USE MATH_FUNCTIONS, ONLY : GET_RAMP_INDEX
USE DEVICE_VARIABLES, ONLY : PROPERTY_TYPE
CHARACTER(LABEL_LENGTH) :: PART_ID,RAMP_MF(MAX_SPECIES),RAMP_Q,RAMP_V,RAMP_T,MATL_ID(MAX_LAYERS,MAX_MATERIALS),&
                 PROFILE,BACKING,GEOMETRY,NAME_LIST(MAX_MATERIALS*MAX_LAYERS),EXTERNAL_FLUX_RAMP,RAMP_EF,RAMP_PART,&
                 SPEC_ID(MAX_SPECIES),RAMP_T_B,RAMP_T_I,RAMP_V_X,RAMP_V_Y,RAMP_V_Z
EQUIVALENCE(EXTERNAL_FLUX_RAMP,RAMP_EF)
LOGICAL :: ADIABATIC,BURN_AWAY,FREE_SLIP,NO_SLIP,CONVERT_VOLUME_TO_MASS,IMPERMEABLE,MASS_TRANSFER
CHARACTER(LABEL_LENGTH) :: TEXTURE_MAP,HEAT_TRANSFER_MODEL,LEAK_PATH_ID(2)
CHARACTER(25) :: COLOR
REAL(EB) :: TAU_Q,TAU_V,TAU_T,TAU_MF(MAX_SPECIES),HRRPUA,MLRPUA,TEXTURE_WIDTH,TEXTURE_HEIGHT,VEL_T(2),&
            TAU_EXTERNAL_FLUX,TAU_EF,E_COEFFICIENT,VOLUME_FLOW,VOLUME_FLUX,&
            TMP_FRONT,TMP_INNER(MAX_LAYERS),THICKNESS(MAX_LAYERS),VEL,VEL_BULK,INTERNAL_HEAT_SOURCE(MAX_LAYERS),&
            MASS_FLUX(MAX_SPECIES),Z0,PLE,CONVECTIVE_HEAT_FLUX,PARTICLE_MASS_FLUX,&
            TRANSPARENCY,EXTERNAL_FLUX,TMP_BACK,MASS_FLUX_TOTAL,MASS_FLUX_VAR,STRETCH_FACTOR(MAX_LAYERS),CONVECTION_LENGTH_SCALE,&
            MATL_MASS_FRACTION(MAX_LAYERS,MAX_MATERIALS),CELL_SIZE_FACTOR,MAX_PRESSURE,&
            EXTINCTION_TEMPERATURE,IGNITION_TEMPERATURE,HEAT_OF_VAPORIZATION,NET_HEAT_FLUX,LAYER_DIVIDE,&
            ROUGHNESS,RADIUS,INNER_RADIUS,LENGTH,WIDTH,DT_INSERT,HEAT_TRANSFER_COEFFICIENT,HEAT_TRANSFER_COEFFICIENT_BACK,&
            TAU_PART,EMISSIVITY,EMISSIVITY_BACK,EMISSIVITY_DEFAULT,SPREAD_RATE,XYZ(3),MINIMUM_LAYER_THICKNESS,VEL_GRAD,&
            MASS_FRACTION(MAX_SPECIES),MASS_TRANSFER_COEFFICIENT,&
            C_FORCED_CONSTANT,C_FORCED_PR_EXP,C_FORCED_RE,C_FORCED_RE_EXP,C_VERTICAL,C_HORIZONTAL,&
            PARTICLE_SURFACE_DENSITY,&
            MOISTURE_FRACTION(MAX_LAYERS),SURFACE_VOLUME_RATIO(MAX_LAYERS),PACKING_RATIO(MAX_LAYERS),SHAPE_FACTOR,&
            FSK_K(MAX_NUMBER_FSK_POINTS),FSK_A(MAX_NUMBER_FSK_POINTS),FSK_W(MAX_NUMBER_FSK_POINTS),SUM_D,RHO_DRY,X_AIR,&
            DRAG_COEFFICIENT,MINIMUM_BURNOUT_TIME,DELTA_TMP_MAX,BURN_DURATION,CONE_HEAT_FLUX,AREA_MULTIPLIER,&
            Z_0,AERODYNAMIC_ROUGHNESS
EQUIVALENCE(TAU_EXTERNAL_FLUX,TAU_EF)
EQUIVALENCE(Z_0,AERODYNAMIC_ROUGHNESS)
INTEGER :: NPPC,N,IOS,NL,NN,NNN,N_LIST,N_LIST2,INDEX_LIST(MAX_MATERIALS_TOTAL),LEAK_PATH(2),DUCT_PATH(2),RGB(3),NR,IL
INTEGER ::  N_LAYER_CELLS_MAX(MAX_LAYERS),VEG_LSET_FUEL_INDEX,SUBSTEP_POWER
REAL(EB) :: VEG_LSET_IGNITE_TIME,VEG_LSET_QCON,VEG_LSET_ROS_HEAD,VEG_LSET_ROS_FLANK,VEG_LSET_ROS_BACK, &
            VEG_LSET_WIND_EXP,VEG_LSET_BETA,VEG_LSET_HT,VEG_LSET_SIGMA,VEG_LSET_ROS_00, &
            VEG_LSET_M1,VEG_LSET_M10,VEG_LSET_M100,VEG_LSET_MLW,VEG_LSET_MLH,VEG_LSET_SURF_LOAD,VEG_LSET_FIREBASE_TIME,&
            VEG_LSET_CHAR_FRACTION
LOGICAL :: DEFAULT,EVAC_DEFAULT,VEG_LSET_SPREAD,VEG_LSET_TAN2,TGA_ANALYSIS,COMPUTE_EMISSIVITY,&
           COMPUTE_EMISSIVITY_BACK,HT3D,THERM_THICK,BLOWING,BLOWING_2,ABL_MODEL

NAMELIST /SURF/ ADIABATIC,AERODYNAMIC_ROUGHNESS,AREA_MULTIPLIER,BACKING,BLOWING,BLOWING_2,BURN_AWAY,BURN_DURATION,&
                CELL_SIZE_FACTOR,&
                C_FORCED_CONSTANT,C_FORCED_PR_EXP,C_FORCED_RE,C_FORCED_RE_EXP,C_HORIZONTAL,C_VERTICAL,COLOR,CONE_HEAT_FLUX,&
                CONVECTION_LENGTH_SCALE,CONVECTIVE_HEAT_FLUX,CONVERT_VOLUME_TO_MASS,DEFAULT,DELTA_TMP_MAX,DRAG_COEFFICIENT,&
                DT_INSERT,E_COEFFICIENT,EMISSIVITY,EMISSIVITY_BACK,EVAC_DEFAULT,EXTERNAL_FLUX,EXTINCTION_TEMPERATURE,&
                FSK_A,FSK_K,FSK_W,&
                FREE_SLIP,FYI,GEOMETRY,HEAT_OF_VAPORIZATION,HEAT_TRANSFER_COEFFICIENT,HEAT_TRANSFER_COEFFICIENT_BACK,&
                HEAT_TRANSFER_MODEL,HRRPUA,HT3D,ID,IGNITION_TEMPERATURE,IMPERMEABLE,&
                INNER_RADIUS,INTERNAL_HEAT_SOURCE,LAYER_DIVIDE,&
                LEAK_PATH,LEAK_PATH_ID,LENGTH,MASS_FLUX,MASS_FLUX_TOTAL,MASS_FLUX_VAR,MASS_FRACTION,MASS_TRANSFER,&
                MASS_TRANSFER_COEFFICIENT, &
                MATL_ID,MATL_MASS_FRACTION,MINIMUM_BURNOUT_TIME,MINIMUM_LAYER_THICKNESS,MLRPUA,MOISTURE_FRACTION,&
                N_LAYER_CELLS_MAX,NET_HEAT_FLUX,NO_SLIP,NPPC,PACKING_RATIO,&
                PARTICLE_MASS_FLUX,PARTICLE_SURFACE_DENSITY,PART_ID,PLE,PROFILE,RADIUS,RAMP_EF,RAMP_MF,&
                RAMP_PART,RAMP_Q,RAMP_T,RAMP_T_B,RAMP_T_I,RAMP_V,RAMP_V_X,RAMP_V_Y,RAMP_V_Z,RGB,ROUGHNESS,SHAPE_FACTOR,SPEC_ID,&
                SPREAD_RATE,STRETCH_FACTOR,SUBSTEP_POWER,SURFACE_VOLUME_RATIO,&
                TAU_EF,TAU_MF,TAU_PART,TAU_Q,TAU_T,TAU_V,TEXTURE_HEIGHT,TEXTURE_MAP,TEXTURE_WIDTH,&
                TGA_ANALYSIS,TGA_FINAL_TEMPERATURE,TGA_HEATING_RATE,THICKNESS,&
                TMP_BACK,TMP_FRONT,TMP_INNER,TRANSPARENCY,&
                VEG_LSET_BETA,VEG_LSET_CHAR_FRACTION,VEG_LSET_FIREBASE_TIME,VEG_LSET_FUEL_INDEX,VEG_LSET_HT,VEG_LSET_IGNITE_TIME,&
                VEG_LSET_M1,VEG_LSET_M10,VEG_LSET_M100,VEG_LSET_MLW,VEG_LSET_MLH,VEG_LSET_QCON,&
                VEG_LSET_ROS_00,VEG_LSET_ROS_BACK,VEG_LSET_ROS_FLANK,VEG_LSET_ROS_HEAD,VEG_LSET_SIGMA,&
                VEG_LSET_SURF_LOAD,VEG_LSET_TAN2,VEG_LSET_WIND_EXP,&
                VEL,VEL_BULK,VEL_GRAD,VEL_T,VOLUME_FLOW,WIDTH,XYZ,Z0,Z_0,&
                EXTERNAL_FLUX_RAMP,TAU_EXTERNAL_FLUX,VOLUME_FLUX ! Backwards compatability??

! Count the SURF lines in the input file

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
N_SURF = 0
COUNT_SURF_LOOP: DO
   CALL CHECKREAD('SURF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_SURF_LOOP
   READ(LU_INPUT,SURF,ERR=34,IOSTAT=IOS)
   N_SURF = N_SURF + 1
   34 IF (IOS>0) THEN
         WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with SURF number ',N_SURF+1,', line number ',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
ENDDO COUNT_SURF_LOOP

! Allocate the SURFACE derived type, leaving space for SURF entries not defined explicitly by the user

N_SURF_RESERVED = 10
ALLOCATE(SURFACE(0:N_SURF+N_SURF_RESERVED),STAT=IZERO)
CALL ChkMemErr('READ','SURFACE',IZERO)

! Count the SURF lines in the input file

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
NN = 0 ; ID = 'null'
COUNT_SURF_LOOP_AGAIN: DO
   CALL CHECKREAD('SURF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_SURF_LOOP_AGAIN
   READ(LU_INPUT,SURF)
   NN = NN+1
   SURFACE(NN)%ID = ID
   DO NNN=1,NN-1
      IF (SURFACE(NNN)%ID==SURFACE(NN)%ID) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ID <',TRIM(SURFACE(NN)%ID),'> is used more than once'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO
ENDDO COUNT_SURF_LOOP_AGAIN

! Add extra surface types to the list that has already been compiled

INERT_SURF_INDEX             = 0
OPEN_SURF_INDEX              = N_SURF + 1
MIRROR_SURF_INDEX            = N_SURF + 2
INTERPOLATED_SURF_INDEX      = N_SURF + 3
PERIODIC_SURF_INDEX          = N_SURF + 4
HVAC_SURF_INDEX              = N_SURF + 5
MASSLESS_TRACER_SURF_INDEX   = N_SURF + 6
DROPLET_SURF_INDEX           = N_SURF + 7
EVACUATION_SURF_INDEX        = N_SURF + 8
MASSLESS_TARGET_SURF_INDEX   = N_SURF + 9
PERIODIC_FLOW_ONLY_SURF_INDEX= N_SURF + 10

N_SURF = N_SURF + N_SURF_RESERVED

SURFACE(INERT_SURF_INDEX)%ID             = 'INERT'
SURFACE(OPEN_SURF_INDEX)%ID              = 'OPEN'
SURFACE(MIRROR_SURF_INDEX)%ID            = 'MIRROR'
SURFACE(INTERPOLATED_SURF_INDEX)%ID      = 'INTERPOLATED'
SURFACE(PERIODIC_SURF_INDEX)%ID          = 'PERIODIC'
SURFACE(HVAC_SURF_INDEX)%ID              = 'HVAC'
SURFACE(MASSLESS_TRACER_SURF_INDEX)%ID   = 'MASSLESS TRACER'
SURFACE(DROPLET_SURF_INDEX)%ID           = 'DROPLET'
SURFACE(EVACUATION_SURF_INDEX)%ID        = 'EVACUATION_OUTFLOW'
SURFACE(MASSLESS_TARGET_SURF_INDEX)%ID   = 'MASSLESS TARGET'
SURFACE(PERIODIC_FLOW_ONLY_SURF_INDEX)%ID= 'PERIODIC FLOW ONLY'

SURFACE(0)%USER_DEFINED                               = .FALSE.
SURFACE(N_SURF-N_SURF_RESERVED+1:N_SURF)%USER_DEFINED = .FALSE.

! Check if SURF_DEFAULT exists

CALL CHECK_SURF_NAME(SURF_DEFAULT,EX)
IF (.NOT.EX) THEN
   WRITE(MESSAGE,'(A)') 'ERROR: SURF_DEFAULT not found'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

! Add evacuation boundary type if necessary

CALL CHECK_SURF_NAME(EVAC_SURF_DEFAULT,EX)
IF (.NOT.EX) THEN
   WRITE(MESSAGE,'(A)') 'ERROR: EVAC_SURF_DEFAULT not found'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

! Read the SURF lines

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
READ_SURF_LOOP: DO N=0,N_SURF

   SF => SURFACE(N)

   ! Allocate arrays associated with the SURF line

   ALLOCATE(SF%MASS_FRACTION(1:N_TRACKED_SPECIES),STAT=IZERO)
   CALL ChkMemErr('READ','SURFACE',IZERO) ; SF%MASS_FRACTION = 0._EB
   ALLOCATE(SF%MASS_FLUX(1:N_TRACKED_SPECIES),STAT=IZERO)
   CALL ChkMemErr('READ','SURFACE',IZERO) ; SF%MASS_FLUX = 0._EB
   ALLOCATE(SF%TAU(-5:N_TRACKED_SPECIES),STAT=IZERO)
   CALL ChkMemErr('READ','SURFACE',IZERO) ; SF%TAU = 0._EB
   ALLOCATE(SF%ADJUST_BURN_RATE(-5:N_TRACKED_SPECIES),STAT=IZERO)
   CALL ChkMemErr('READ','SURFACE',IZERO) ; SF%ADJUST_BURN_RATE = 1._EB
   ALLOCATE(SF%RAMP_INDEX(-8:N_TRACKED_SPECIES),STAT=IZERO)
   CALL ChkMemErr('READ','SURFACE',IZERO) ; SF%RAMP_INDEX = 0
   ALLOCATE(SF%RAMP_MF(1:N_TRACKED_SPECIES),STAT=IZERO)
   CALL ChkMemErr('READ','SURFACE',IZERO) ; SF%RAMP_MF = 'null'

   ! Read the user defined SURF lines

   CALL SET_SURF_DEFAULTS

   IF (SF%USER_DEFINED) THEN
      CALL CHECKREAD('SURF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      READ(LU_INPUT,SURF)
   ENDIF

   ! Check to make sure that a DEFAULT SURF has an ID

   IF (DEFAULT) THEN
      IF (ID=='null') ID = 'DEFAULT SURF'
      SURF_DEFAULT = TRIM(ID)
   ENDIF

   ! Translate various forestry/vegetation terms into FDS parameters

   SF%SURFACE_VOLUME_RATIO(:) = SURFACE_VOLUME_RATIO(:)
   SF%MOISTURE_FRACTION(:)    = MOISTURE_FRACTION(:)
   SF%PACKING_RATIO(:)        = PACKING_RATIO(:)
   SF%SHAPE_FACTOR            = SHAPE_FACTOR
   SF%DRAG_COEFFICIENT        = DRAG_COEFFICIENT

   IF (ANY(MOISTURE_FRACTION>0._EB) .OR. ANY(PACKING_RATIO>0._EB) .OR. ANY(SURFACE_VOLUME_RATIO>0._EB)) THEN

      IF (ANY(PACKING_RATIO>0._EB)) THEN  ! Determine convective heat transfer coefficient based on element, not surface geometry
         CONVECTION_LENGTH_SCALE = 4._EB/SURFACE_VOLUME_RATIO(1)
         HEAT_TRANSFER_MODEL = 'BOUNDARY FUEL HTC MODEL'
      ENDIF

      LAYER_LOOP_2: DO NL=1,MAX_LAYERS

         IF (SURFACE_VOLUME_RATIO(NL)>0._EB .AND. THICKNESS(NL)<0._EB) THEN  ! Convert SURFACE_VOLUME_RATIO into a THICKNESS
            SELECT CASE(GEOMETRY)
               CASE('CARTESIAN')   ; THICKNESS(NL) = 1._EB/SURFACE_VOLUME_RATIO(NL)
               CASE('CYLINDRICAL') ; THICKNESS(NL) = 2._EB/SURFACE_VOLUME_RATIO(NL)
               CASE('SPHERICAL')   ; THICKNESS(NL) = 3._EB/SURFACE_VOLUME_RATIO(NL)
            END SELECT
         ENDIF

         IF (THICKNESS(NL) < 0._EB) EXIT LAYER_LOOP_2

         SUM_D = 0._EB
         DO NN=1,MAX_MATERIALS
            IF (MATL_ID(NL,NN) == 'null') EXIT
            DO NNN=1,N_MATL
               IF (MATL_ID(NL,NN)==MATERIAL(NNN)%ID) EXIT
            ENDDO
            SUM_D = SUM_D + MATL_MASS_FRACTION(NL,NN)/MATERIAL(NNN)%RHO_S
         ENDDO
         RHO_DRY = 1._EB/SUM_D
         IF (PACKING_RATIO(NL)>0._EB) THEN  ! Add AIR
            SF%BOUNDARY_FUEL_MODEL = .TRUE.
            SF%KAPPA_S(NL) = SHAPE_FACTOR*PACKING_RATIO(NL)*SURFACE_VOLUME_RATIO(NL)
            X_AIR = 1._EB - PACKING_RATIO(NL)
            MATL_ID(NL,NN) = 'AIR'
            MATL_MASS_FRACTION(NL,NN) = X_AIR*1.2_EB/(X_AIR*1.2_EB + (1._EB-X_AIR)*RHO_DRY)
            MATL_MASS_FRACTION(NL,1:NN-1) = MATL_MASS_FRACTION(NL,1:NN-1)*(1._EB-MATL_MASS_FRACTION(NL,NN))
            NN = NN+1
         ENDIF

         IF (MOISTURE_FRACTION(NL)>0._EB) THEN  ! Add MOISTURE
            MATL_ID(NL,NN) = 'MOISTURE'
            MATL_MASS_FRACTION(NL,NN) = MOISTURE_FRACTION(NL)/(1._EB+MOISTURE_FRACTION(NL))
            MATL_MASS_FRACTION(NL,1:NN-1) = MATL_MASS_FRACTION(NL,1:NN-1)*(1._EB-MATL_MASS_FRACTION(NL,NN))
         ENDIF

      ENDDO LAYER_LOOP_2

   ENDIF

   ! Set EVAC default

   IF (EVAC_DEFAULT) EVAC_SURF_DEFAULT = TRIM(ID)

   ! Look for special TGA_ANALYSIS=.TRUE. to indicate that only a TGA analysis is to be done

   IF (TGA_ANALYSIS) THEN
      GEOMETRY = 'CARTESIAN'
      LENGTH   = 0.1
      WIDTH    = 0.1
      BACKING  = 'INSULATED'
      IF (THICKNESS(2)>0._EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: IF TGA_ANALYSIS=.TRUE., the surface can only be one layer thick'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      THICKNESS = 1.E-6_EB
      HEAT_TRANSFER_COEFFICIENT = 1000._EB
      MINIMUM_LAYER_THICKNESS = 1.E-12_EB
      TGA_SURF_INDEX = N
      INITIAL_RADIATION_ITERATIONS = 0
   ENDIF

   ! Level set vegetation fire spread specific

   VEG_LSET_SPREAD = .FALSE.
   IF (VEG_LSET_IGNITE_TIME < 1.E6_EB .OR. VEG_LSET_FUEL_INDEX>0 .OR. &
       VEG_LSET_ROS_00>0._EB .OR. VEG_LSET_ROS_HEAD>0._EB) VEG_LSET_SPREAD = .TRUE.
   IF (VEG_LSET_SPREAD .AND. LEVEL_SET_MODE==0) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(ID),' indicates a level set simulation, but LEVEL_SET_MODE is not set on MISC.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (VEG_LSET_FUEL_INDEX>0 .AND. LEVEL_SET_COUPLED_FIRE) HRRPUA = 1._EB  ! HRRPUA to be set properly later
   IF (VEG_LSET_ROS_00    >0 .AND. LEVEL_SET_COUPLED_FIRE) HRRPUA = 1._EB
   IF (VEG_LSET_ROS_HEAD  >0 .AND. LEVEL_SET_COUPLED_FIRE) HRRPUA = 1._EB

   SF%VEG_LSET_SPREAD       = VEG_LSET_SPREAD
   SF%VEG_LSET_ROS_00       = VEG_LSET_ROS_00       ! no-wind, no-slope RoS (m/s), Rothermel model
   SF%VEG_LSET_ROS_HEAD     = VEG_LSET_ROS_HEAD     ! head fire rate of spread (m/s), McArthur model
   SF%VEG_LSET_ROS_FLANK    = VEG_LSET_ROS_FLANK    ! flank fire rate of spread, McArthur model
   SF%VEG_LSET_ROS_BACK     = VEG_LSET_ROS_BACK     ! back fire rate of spread, McArthur model
   SF%VEG_LSET_WIND_EXP     = VEG_LSET_WIND_EXP     ! exponent on wind cosine in ROS formula
   SF%VEG_LSET_SIGMA        = VEG_LSET_SIGMA * 0.01 ! SAV for Farsite emulation in LSET converted to 1/cm
   SF%VEG_LSET_HT           = VEG_LSET_HT
   SF%VEG_LSET_BETA         = VEG_LSET_BETA
   SF%VEG_LSET_TAN2         = VEG_LSET_TAN2
   SF%VEG_LSET_IGNITE_T     = VEG_LSET_IGNITE_TIME
   SF%VEG_LSET_QCON         =-VEG_LSET_QCON*1000._EB ! convert from kW/m^2 to W/m^2
   SF%VEG_LSET_M1           = VEG_LSET_M1
   SF%VEG_LSET_M10          = VEG_LSET_M10
   SF%VEG_LSET_M100         = VEG_LSET_M100
   SF%VEG_LSET_MLW          = VEG_LSET_MLW
   SF%VEG_LSET_MLH          = VEG_LSET_MLH
   SF%VEG_LSET_FUEL_INDEX   = VEG_LSET_FUEL_INDEX
   SF%VEG_LSET_SURF_LOAD    = VEG_LSET_SURF_LOAD
   SF%VEG_LSET_CHAR_FRACTION= VEG_LSET_CHAR_FRACTION
   IF (VEG_LSET_FIREBASE_TIME<0._EB) SF%VEG_LSET_FIREBASE_TIME = 75600._EB/VEG_LSET_SIGMA

   IF (SF%VEG_LSET_FUEL_INDEX>0 .AND. COLOR=='null' .AND. ANY(RGB<0)) THEN
      SELECT CASE(SF%VEG_LSET_FUEL_INDEX)
         CASE(1)  ; RGB=(/255,254,212/)
         CASE(2)  ; RGB=(/255,253,102/)
         CASE(3)  ; RGB=(/236,212, 99/)
         CASE(4)  ; RGB=(/254,193,119/)
         CASE(5)  ; RGB=(/249,197, 92/)
         CASE(6)  ; RGB=(/217,196,152/)
         CASE(7)  ; RGB=(/170,155,127/)
         CASE(8)  ; RGB=(/229,253,214/)
         CASE(9)  ; RGB=(/162,191, 90/)
         CASE(10) ; RGB=(/114,154, 85/)
         CASE(11) ; RGB=(/235,212,253/)
         CASE(12) ; RGB=(/163,177,243/)
         CASE(13) ; RGB=(/  0,  0,  0/)
      END SELECT
   ENDIF

   ! Minimum and maximum time required to consume all the fuel

   SF%BURN_DURATION = BURN_DURATION
   SF%MINIMUM_BURNOUT_TIME = MINIMUM_BURNOUT_TIME

   ! If a RADIUS is specified, consider it the same as THICKNESS(1)

   IF (RADIUS>0._EB) THICKNESS(1) = RADIUS

   ! If HT3D set THICKNESS(1) to null value to pass error traps

   IF (HT3D .AND. MATL_ID(1,1)/='null') THICKNESS(1) = 1._EB

   ! Check SURF parameters for potential problems

   LAYER_LOOP: DO IL=1,MAX_LAYERS
      IF ((ADIABATIC.OR.NET_HEAT_FLUX<1.E12_EB.OR.ABS(CONVECTIVE_HEAT_FLUX)>TWO_EPSILON_EB.OR.TMP_FRONT>-TMPM) &
         .AND. MATL_ID(IL,1)/='null') THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' cannot have a specified flux or temperature and a MATL_ID'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (THICKNESS(IL)<=0._EB .AND. MATL_ID(IL,1)/='null') THEN
         WRITE(MESSAGE,'(A,I0)') 'ERROR: SURF '//TRIM(SF%ID)// ' must have a specified THICKNESS for Layer ',IL
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO LAYER_LOOP

   IF ((GEOMETRY=='CYLINDRICAL' .OR. GEOMETRY=='SPHERICAL') .AND. RADIUS<0._EB .AND. THICKNESS(1)<0._EB) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' needs a RADIUS or THICKNESS'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Identify the default SURF

   IF (ID==SURF_DEFAULT) DEFAULT_SURF_INDEX = N

   ! Pack SURF parameters into the SURFACE derived type

   SF                      => SURFACE(N)
   SF%ABL_MODEL            = ABL_MODEL
   SF%ADIABATIC            = ADIABATIC
   SF%AREA_MULTIPLIER      = AREA_MULTIPLIER
   SELECT CASE(BACKING)
      CASE('VOID')
         SF%BACKING        = VOID
      CASE('INSULATED')
         SF%BACKING        = INSULATED
      CASE('EXPOSED')
         SF%BACKING        = EXPOSED
      CASE DEFAULT
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//', BACKING '//TRIM(BACKING)//' not recognized'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   END SELECT
   SF%BURN_AWAY            = BURN_AWAY
   SF%BLOWING              = BLOWING
   SF%BLOWING_2            = BLOWING_2
   IF (SF%BLOWING .AND. SF%BLOWING_2) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//', Cannot use both BLOWING and BLOWING_2.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   SF%CONE_HEAT_FLUX       = CONE_HEAT_FLUX*1000._EB
   SF%CELL_SIZE_FACTOR     = CELL_SIZE_FACTOR
   SF%CONVECTIVE_HEAT_FLUX = 1000._EB*CONVECTIVE_HEAT_FLUX
   SF%C_FORCED_CONSTANT    = C_FORCED_CONSTANT
   SF%C_FORCED_PR_EXP      = C_FORCED_PR_EXP
   SF%C_FORCED_RE          = C_FORCED_RE
   SF%C_FORCED_RE_EXP      = C_FORCED_RE_EXP
   SF%C_HORIZONTAL         = C_HORIZONTAL
   SF%C_VERTICAL           = C_VERTICAL
   SF%CONV_LENGTH          = CONVECTION_LENGTH_SCALE
   SF%CONVERT_VOLUME_TO_MASS = CONVERT_VOLUME_TO_MASS
   IF (SF%CONVERT_VOLUME_TO_MASS .AND. TMP_FRONT<-TMPM) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' must specify TMP_FRONT for CONVERT_VOLUME_TO_MASS'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (SF%CONVERT_VOLUME_TO_MASS .AND. (RAMP_V/='null' .OR. RAMP_V_X/='null' .OR. RAMP_V_Y/='null' .OR. RAMP_V_Z/='null')) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' cannot use velocity RAMP with CONVERT_VOLUME_TO_MASS'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   SF%NET_HEAT_FLUX        = 1000._EB*NET_HEAT_FLUX
   SF%DELTA_TMP_MAX        = DELTA_TMP_MAX
   SF%DUCT_PATH            = DUCT_PATH
   SF%DT_INSERT            = DT_INSERT
   SF%E_COEFFICIENT        = E_COEFFICIENT
   SF%EMISSIVITY           = EMISSIVITY
   SF%EMISSIVITY_BACK      = EMISSIVITY_BACK
   SF%FIRE_SPREAD_RATE     = SPREAD_RATE / TIME_SHRINK_FACTOR
   SF%FREE_SLIP            = FREE_SLIP
   SF%FSK_K                = FSK_K
   SF%FSK_A                = FSK_A
   SF%FSK_W                = FSK_W
   SF%NO_SLIP              = NO_SLIP
   SF%FYI                  = FYI
   SF%EXTERNAL_FLUX        = 1000._EB*EXTERNAL_FLUX
   SF%HT3D                 = HT3D
   SF%IMPERMEABLE          = IMPERMEABLE
   SF%INNER_RADIUS         = INNER_RADIUS
   SELECT CASE(GEOMETRY)
      CASE('CARTESIAN')
         SF%GEOMETRY       = SURF_CARTESIAN
         IF (SF%WIDTH>0._EB)                 SF%BACKING = INSULATED
      CASE('CYLINDRICAL')
         SF%GEOMETRY       = SURF_CYLINDRICAL
         IF (SF%INNER_RADIUS<TWO_EPSILON_EB) SF%BACKING = INSULATED
      CASE('SPHERICAL')
         SF%GEOMETRY       = SURF_SPHERICAL
         IF (SF%INNER_RADIUS<TWO_EPSILON_EB) SF%BACKING = INSULATED
      CASE DEFAULT
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' GEOMETRY not recognized'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   END SELECT

   SF%H_V = 1000._EB*HEAT_OF_VAPORIZATION
   SELECT CASE(HEAT_TRANSFER_MODEL)
      CASE DEFAULT
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' HEAT_TRANSFER_MODEL not recognized'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      CASE('null')
         IF (ABS(C_FORCED_CONSTANT)>TWO_EPSILON_EB .OR. ABS(C_FORCED_RE)>TWO_EPSILON_EB) THEN
            SF%HEAT_TRANSFER_MODEL = CUSTOM_HTC_MODEL
         ELSE
            SF%HEAT_TRANSFER_MODEL = DEFAULT_HTC_MODEL
         ENDIF
      CASE('LOGLAW','LOG LAW')
         SF%HEAT_TRANSFER_MODEL = LOGLAW_HTC_MODEL
      CASE('ABL')
         SF%HEAT_TRANSFER_MODEL = ABL_HTC_MODEL
         SF%ABL_MODEL = .TRUE.
      CASE('RAYLEIGH')
         SF%HEAT_TRANSFER_MODEL = RAYLEIGH_HTC_MODEL
      CASE('YUAN')
         SF%HEAT_TRANSFER_MODEL = YUAN_HTC_MODEL
      CASE('FREE HORIZONTAL CYLINDER')
         SF%HEAT_TRANSFER_MODEL = FREE_HORIZONTAL_CYLINDER_HTC_MODEL
      CASE('BOUNDARY FUEL HTC MODEL')
         SF%HEAT_TRANSFER_MODEL = BOUNDARY_FUEL_HTC_MODEL
   END SELECT
   IF (SF%BLOWING) SF%HEAT_TRANSFER_MODEL = BLOWING_HTC_MODEL
   IF (SF%BLOWING_2) SF%HEAT_TRANSFER_MODEL = RAYLEIGH_HTC_MODEL

   SF%HRRPUA               = 1000._EB*HRRPUA
   SF%MLRPUA               = MLRPUA
   SF%LAYER_DIVIDE         = LAYER_DIVIDE

   IF (ANY(LEAK_PATH>=0) .AND. ANY(LEAK_PATH_ID/='null')) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' Define only one of LEAK_PATH and LEAK_PATH_ID'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   SF%LEAK_PATH            = LEAK_PATH
   SF%LEAK_PATH_ID         = LEAK_PATH_ID
   SF%LENGTH               = LENGTH
   SF%MT1D                 = MASS_TRANSFER
   SF%MASS_FLUX            = 0._EB
   SF%MASS_FLUX_VAR        = MASS_FLUX_VAR
   SF%MASS_FRACTION        = 0._EB
   SF%MAX_PRESSURE         = MAX_PRESSURE
   SF%MINIMUM_LAYER_THICKNESS = MINIMUM_LAYER_THICKNESS
   IF (ANY(N_LAYER_CELLS_MAX<1)) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' N_LAYER_CELLS_MAX must be >= 2'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   SF%N_LAYER_CELLS_MAX    = N_LAYER_CELLS_MAX+1
   SF%NRA                  = NUMBER_RADIATION_ANGLES
   SF%NSB                  = NUMBER_SPECTRAL_BANDS
   SF%NPPC                 = NPPC
   SF%SUBSTEP_POWER        = SUBSTEP_POWER
   SF%PARTICLE_MASS_FLUX   = PARTICLE_MASS_FLUX
   SF%PARTICLE_SURFACE_DENSITY = PARTICLE_SURFACE_DENSITY
   ALLOCATE(SF%PARTICLE_INSERT_CLOCK(NMESHES),STAT=IZERO)
   CALL ChkMemErr('READ','PARTICLE_INSERT_CLOCK',IZERO)
   IF (SF%PARTICLE_MASS_FLUX>0._EB) THEN
      SF%PARTICLE_INSERT_CLOCK = SF%DT_INSERT
   ELSE
      SF%PARTICLE_INSERT_CLOCK = T_BEGIN
   ENDIF
   SF%PART_ID              = PART_ID
   SF%PLE                  = PLE
   SELECT CASE (PROFILE)
      CASE('null')
         SF%PROFILE        = 0
      CASE('ATMOSPHERIC')
         SF%PROFILE        = ATMOSPHERIC_PROFILE
      CASE('PARABOLIC')
         SF%PROFILE        = PARABOLIC_PROFILE
      CASE('BOUNDARY LAYER')
         SF%PROFILE        = BOUNDARY_LAYER_PROFILE
      CASE('RAMP')
         SF%PROFILE        = RAMP_PROFILE
   END SELECT
   SF%RAMP_EF              = EXTERNAL_FLUX_RAMP
   SF%RAMP_MF              = 'null'
   SF%RAMP_Q               = RAMP_Q
   SF%RAMP_V               = RAMP_V
   SF%RAMP_T               = RAMP_T
   SF%RAMP_T_B             = RAMP_T_B
   SF%RAMP_T_I             = RAMP_T_I
   SF%RAMP_PART            = RAMP_PART
   SF%RAMP_V_X             = RAMP_V_X
   SF%RAMP_V_Y             = RAMP_V_Y
   SF%RAMP_V_Z             = RAMP_V_Z

   IF (COLOR/='null') THEN
      IF (COLOR=='INVISIBLE') THEN
         TRANSPARENCY = 0._EB
      ELSE
         CALL COLOR2RGB(RGB,COLOR)
      ENDIF
   ENDIF
   IF (ANY(RGB< 0)) THEN
      RGB(1) = 255
      RGB(2) = 204
      RGB(3) = 102
   ENDIF
   IF (SF%ID=="OPEN") THEN
      RGB(1) = 255
      RGB(2) = 0
      RGB(3) = 255
   ENDIF
   SF%RGB                  = RGB
   SF%ROUGHNESS            = ROUGHNESS
   SF%TRANSPARENCY         = TRANSPARENCY
   SF%STRETCH_FACTOR       = STRETCH_FACTOR
   SF%TAU(TIME_HEAT)       = TAU_Q/TIME_SHRINK_FACTOR
   SF%TAU(TIME_VELO)       = TAU_V/TIME_SHRINK_FACTOR
   SF%TAU(TIME_TEMP)       = TAU_T/TIME_SHRINK_FACTOR
   SF%TAU(TIME_EFLUX)      = TAU_EXTERNAL_FLUX/TIME_SHRINK_FACTOR
   SF%TAU(TIME_PART)       = TAU_PART/TIME_SHRINK_FACTOR
   SF%TEXTURE_MAP          = TEXTURE_MAP
   SF%TEXTURE_WIDTH        = TEXTURE_WIDTH
   SF%TEXTURE_HEIGHT       = TEXTURE_HEIGHT
   SF%TMP_EXT              = EXTINCTION_TEMPERATURE + TMPM
   SF%TMP_IGN              = IGNITION_TEMPERATURE + TMPM
   SF%VEL                  = VEL
   SF%VEL_BULK             = VEL_BULK
   SF%VEL_GRAD             = VEL_GRAD
   SF%VEL_T                = VEL_T
   SF%VOLUME_FLOW          = VOLUME_FLOW
   SF%WIDTH                = WIDTH
   SF%Z0                   = Z0
   IF (HEAT_TRANSFER_COEFFICIENT_BACK < 0._EB) HEAT_TRANSFER_COEFFICIENT_BACK=HEAT_TRANSFER_COEFFICIENT
   SF%H_FIXED              = HEAT_TRANSFER_COEFFICIENT
   SF%H_FIXED_B            = HEAT_TRANSFER_COEFFICIENT_BACK
   SF%HM_FIXED             = MASS_TRANSFER_COEFFICIENT
   SF%XYZ                  = XYZ
   SF%Z_0                  = Z_0

   ! Roughness conversion

   IF (SF%ROUGHNESS>=0._EB .AND. SF%Z_0>=0._EB) THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID), &
      '. Specify either ROUGHNESS or Z_0, not both'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (SF%ROUGHNESS>=0._EB) THEN
      SF%Z_0 = SF%ROUGHNESS * EXP(-BTILDE_ROUGH*VON_KARMAN_CONSTANT) ! Z_0 \approx ROUGHNESS * 0.0306
   ENDIF
   IF (SF%Z_0>=0._EB) THEN
      SF%ROUGHNESS = SF%Z_0 * EXP(BTILDE_ROUGH*VON_KARMAN_CONSTANT)  ! ROUGHNESS \approx Z_0 * 32.6
   ENDIF
   IF (SF%ROUGHNESS<0._EB .AND. SF%Z_0<0._EB) THEN
      SF%ROUGHNESS = 0._EB
      SF%Z_0 = 0._EB
   ENDIF

   ! Convert inflowing MASS_FLUX_TOTAL to MASS_FLUX

   IF (MASS_FLUX_TOTAL >= 0._EB) THEN
      SF%MASS_FLUX_TOTAL = MASS_FLUX_TOTAL
   ELSE
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID), &
      '. MASS_FLUX_TOTAL should only be used for outflow. Use MASS_FLUX for inflow'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Error checking

   IF (DEFAULT .AND. &
          (TRIM(ID)=='OPEN'               .OR. &
           TRIM(ID)=='MIRROR'             .OR. &
           TRIM(ID)=='INTERPOLATED'       .OR. &
           TRIM(ID)=='PERIODIC'           .OR. &
           TRIM(ID)=='HVAC'               .OR. &
           TRIM(ID)=='MASSLESS TRACER'    .OR. &
           TRIM(ID)=='DROPLET'            .OR. &
           TRIM(ID)=='EVACUATION_OUTFLOW' .OR. &
           TRIM(ID)=='MASSLESS TARGET')        ) THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. Cannot set predefined SURF as DEFAULT'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (ABS(VOLUME_FLUX)>0._EB)  THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. VOLUME_FLUX is deprecated; use VOLUME_FLOW'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (ANY(MASS_FLUX>0._EB) .AND. ANY(MASS_FRACTION>0._EB))  THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. Cannot use both MASS_FLUX and MASS_FRACTION'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (ANY(MASS_FLUX<0._EB) .OR. PARTICLE_MASS_FLUX<0._EB)  THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. MASS_FLUX cannot be less than zero'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (ANY(MASS_FLUX>0._EB) .AND. ABS(VEL)>TWO_EPSILON_EB)  THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. Cannot use both MASS_FLUX and VEL'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (ANY(MASS_FLUX>0._EB) .AND. ABS(MASS_FLUX_TOTAL)>TWO_EPSILON_EB)  THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. Cannot use both MASS_FLUX and MASS_FLUX_TOTAL'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (ABS(MASS_FLUX_TOTAL)>TWO_EPSILON_EB .AND. ABS(VEL)>TWO_EPSILON_EB)  THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. Cannot use both MASS_FLUX_TOTAL and VEL'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (ANY(MASS_FRACTION<0._EB))  THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. Cannot use a negative MASS_FRACTION'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (ANY(MASS_FLUX/=0._EB) .OR. ANY(MASS_FRACTION>0._EB)) THEN
      IF (SPEC_ID(1)=='null') THEN
         WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),&
                                   '. Must define SPEC_ID when using MASS_FLUX or MASS_FRACTION'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ELSE
         DO NN=1,MAX_SPECIES
            IF (TRIM(SPEC_ID(NN))=='null') EXIT
            DO NNN=1,N_TRACKED_SPECIES
               IF (TRIM(SPECIES_MIXTURE(NNN)%ID)==TRIM(SPEC_ID(NN))) THEN
                  SF%MASS_FLUX(NNN)    = MASS_FLUX(NN)
                  SF%MASS_FRACTION(NNN)= MASS_FRACTION(NN)
                  SF%TAU(NNN)          = TAU_MF(NN)/TIME_SHRINK_FACTOR
                  SF%RAMP_MF(NNN)      = RAMP_MF(NN)
                  EXIT
               ENDIF
               IF (NNN==N_TRACKED_SPECIES) THEN
                  WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),' SPEC ',TRIM(SPEC_ID(NN)),' not found'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
            ENDDO
         ENDDO
      ENDIF
      IF (SUM(SF%MASS_FRACTION) > TWO_EPSILON_EB) THEN
         IF (SUM(SF%MASS_FRACTION) > 1._EB) THEN
            WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. SUM(MASS_FRACTION) > 1'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (SF%MASS_FRACTION(1) > 0._EB) THEN
            WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID), &
                                      '. Cannot use background species with MASS_FRACTION.'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         SF%MASS_FRACTION(1) = 1._EB - SUM(SF%MASS_FRACTION(2:N_TRACKED_SPECIES))
      ENDIF
   ENDIF

   IF (SF%HEAT_TRANSFER_MODEL==RAYLEIGH_HTC_MODEL .AND. GRAV<TWO_EPSILON_EB)  THEN
      WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),'. Cannot use a RAYLEIGH model with GRAV=0'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (SF%CONE_HEAT_FLUX > 0._EB) THEN
      IF (SF%TMP_IGN>=5000._EB .OR. SF%RAMP_Q=='null' .OR. SF%HRRPUA <=0._EB) THEN
         WRITE (MESSAGE,'(A,A,A)') 'ERROR: Problem with SURF: ',TRIM(SF%ID),&
                                   '. CONE_HEAT_FLUX requires HRRPUA, IGNITION_TEMPERATURE, and RAMP_Q'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ELSE
         N_CONE_RAMP = N_CONE_RAMP + 1
      ENDIF
   ENDIF

   ! Set various logical parameters

   IF (ABS(SF%VEL_T(1))>TWO_EPSILON_EB .OR. ABS(SF%VEL_T(2))>TWO_EPSILON_EB) SF%SPECIFIED_TANGENTIAL_VELOCITY = .TRUE.

   ! Count the number of layers for the surface, and compile a LIST of all material names and indices

   COMPUTE_EMISSIVITY      = .FALSE.
   COMPUTE_EMISSIVITY_BACK = .FALSE.
   IF (SF%EMISSIVITY     <0._EB) COMPUTE_EMISSIVITY      = .TRUE.
   IF (SF%EMISSIVITY_BACK<0._EB) COMPUTE_EMISSIVITY_BACK = .TRUE.

   SF%N_LAYERS = 0
   N_LIST = 0
   NAME_LIST = 'null'
   SF%THICKNESS  = 0._EB
   SF%LAYER_MATL_INDEX = 0
   SF%LAYER_DENSITY    = 0._EB
   INDEX_LIST = -1
   ALLOCATE(SF%LAYER_THICKNESS(MAX_LAYERS))
   SF%LAYER_THICKNESS = 0._EB
   COUNT_LAYERS: DO NL=1,MAX_LAYERS
      IF (THICKNESS(NL) < 0._EB) EXIT COUNT_LAYERS
      SF%N_LAYERS = SF%N_LAYERS + 1
      SF%LAYER_THICKNESS(NL) = THICKNESS(NL)
      SF%N_LAYER_MATL(NL) = 0
      EMISSIVITY = 0._EB
      COUNT_LAYER_MATL: DO NN=1,MAX_MATERIALS
         IF (MATL_ID(NL,NN) == 'null') EXIT COUNT_LAYER_MATL
         N_LIST = N_LIST + 1
         NAME_LIST(N_LIST) = MATL_ID(NL,NN)
         SF%N_LAYER_MATL(NL) = SF%N_LAYER_MATL(NL) + 1
         SF%LAYER_MATL_NAME(NL,NN) = MATL_ID(NL,NN)
         SF%LAYER_MATL_FRAC(NL,NN) = MATL_MASS_FRACTION(NL,NN)
         DO NNN=1,N_MATL
            IF (MATL_NAME(NNN)==NAME_LIST(N_LIST)) THEN
               INDEX_LIST(N_LIST) = NNN
               SF%LAYER_MATL_INDEX(NL,NN) = NNN
               SF%LAYER_DENSITY(NL) = SF%LAYER_DENSITY(NL)+SF%LAYER_MATL_FRAC(NL,NN)/MATERIAL(NNN)%RHO_S
               EMISSIVITY = EMISSIVITY + &
                  MATERIAL(NNN)%EMISSIVITY*SF%LAYER_MATL_FRAC(NL,NN)/MATERIAL(NNN)%RHO_S ! volume based
            ENDIF
         ENDDO
         IF (INDEX_LIST(N_LIST)<0) THEN
            WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR: MATL_ID, ',TRIM(NAME_LIST(N_LIST)),', on SURF, ',TRIM(SF%ID),', does not exist'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ENDDO COUNT_LAYER_MATL
      IF (SF%LAYER_DENSITY(NL) > 0._EB) SF%LAYER_DENSITY(NL) = 1./SF%LAYER_DENSITY(NL)
      IF (COMPUTE_EMISSIVITY_BACK)        SF%EMISSIVITY_BACK = EMISSIVITY*SF%LAYER_DENSITY(NL)
      IF (NL==1 .AND. COMPUTE_EMISSIVITY) SF%EMISSIVITY      = EMISSIVITY*SF%LAYER_DENSITY(NL)
      SF%THICKNESS = SF%THICKNESS + SF%LAYER_THICKNESS(NL)
   ENDDO COUNT_LAYERS

   ! Set emissivity to default value if no other method applies.

   IF (SF%EMISSIVITY      < 0._EB) SF%EMISSIVITY      = EMISSIVITY_DEFAULT
   IF (SF%EMISSIVITY_BACK < 0._EB) SF%EMISSIVITY_BACK = EMISSIVITY_DEFAULT

   ! Define mass flux division point

   IF (SF%LAYER_DIVIDE < 0._EB) THEN
      IF (SF%BACKING==EXPOSED) THEN
         SF%LAYER_DIVIDE = 0.5_EB * REAL(SF%N_LAYERS,EB)
      ELSE
         SF%LAYER_DIVIDE = REAL(SF%N_LAYERS+1)
      ENDIF
   ENDIF

   ! Add residue materials

   DO I = 1,MAX_STEPS    ! repeat the residue loop to find chained reactions - allows MAX_STEPS steps
      N_LIST2 = N_LIST
      DO NN = 1,N_LIST2
         ML=>MATERIAL(INDEX_LIST(NN))
         DO NR=1,ML%N_REACTIONS
            DO NNN=1,ML%N_RESIDUE(NR)
               IF (ML%RESIDUE_MATL_NAME(NNN,NR) == 'null') CYCLE
               IF (ANY(NAME_LIST==ML%RESIDUE_MATL_NAME(NNN,NR))) CYCLE
               N_LIST = N_LIST + 1
               IF (N_LIST>MAX_MATERIALS_TOTAL) THEN ; CALL SHUTDOWN('ERROR: Too many materials in the surface.') ; RETURN ; ENDIF
               NAME_LIST (N_LIST) = ML%RESIDUE_MATL_NAME(NNN,NR)
               INDEX_LIST(N_LIST) = ML%RESIDUE_MATL_INDEX(NNN,NR)
            ENDDO
         ENDDO
      ENDDO
   ENDDO

   ! Eliminate multiply counted materials from the list

   N_LIST2 = N_LIST
   WEED_MATL_LIST: DO NN=1,N_LIST
      DO NNN=1,NN-1
         IF (NAME_LIST(NNN)==NAME_LIST(NN)) THEN
            NAME_LIST(NN)  = 'null'
            INDEX_LIST(NN) = 0
            N_LIST2 = N_LIST2-1
            CYCLE WEED_MATL_LIST
         ENDIF
      ENDDO
   ENDDO WEED_MATL_LIST

   ! Allocate parameters indexed by layer

   IF (TMP_FRONT >= -TMPM) TMPMIN = MIN(TMPMIN,TMP_FRONT+TMPM)
   IF (TMP_BACK >= -TMPM) TMPMIN = MIN(TMPMIN,TMP_BACK+TMPM)
   IF (ASSUMED_GAS_TEMPERATURE >= 0._EB) TMPMIN = MIN(TMPMIN,ASSUMED_GAS_TEMPERATURE)

   SF%N_MATL = N_LIST2
   THERM_THICK = .FALSE.
   IF (SF%LAYER_DENSITY(1) > 0._EB) THEN
      THERM_THICK = .TRUE.
      SF%TMP_INNER = TMP_INNER + TMPM
      IF (SF%TMP_INNER(1)>=0._EB) THEN
         SF%TMP_FRONT = SF%TMP_INNER(1)
         SF%TAU(TIME_TEMP) = 0._EB
      ELSE
         SF%TMP_FRONT = TMP_FRONT + TMPM
      ENDIF
      SF%TMP_BACK = TMP_BACK + TMPM
      ALLOCATE(SF%N_LAYER_CELLS(SF%N_LAYERS))            ! The number of cells in each layer
      ALLOCATE(SF%MIN_DIFFUSIVITY(SF%N_LAYERS))          ! The smallest diffusivity of materials in each layer
      ALLOCATE(SF%MATL_NAME(SF%N_MATL))                  ! The list of all material names associated with the surface
      ALLOCATE(SF%MATL_INDEX(SF%N_MATL))                 ! The list of all material indices associated with the surface
      ALLOCATE(SF%INTERNAL_HEAT_SOURCE(SF%N_LAYERS))     ! Volumetric source term set by the user
   ELSE
      SF%TMP_FRONT = TMP_FRONT + TMPM
      SF%TMP_INNER = SF%TMP_FRONT
      SF%TMP_BACK  = SF%TMP_FRONT
   ENDIF
   DO NN = 1,SF%N_LAYERS
      IF (TMP_INNER(NN)>= -TMPM) TMPMIN = MIN(TMPMIN,TMP_INNER(NN)+TMPM)
   ENDDO

   ! Store the names and indices of all materials associated with the surface

   NNN = 0
   DO NN=1,N_LIST
      IF (NAME_LIST(NN)/='null') THEN
         NNN = NNN + 1
         SF%MATL_NAME(NNN)  = NAME_LIST(NN)
         SF%MATL_INDEX(NNN) = INDEX_LIST(NN)
      ENDIF
   ENDDO

   ! Check for contradictory inputs

   DO NN=1,SF%N_MATL
      ML => MATERIAL(SF%MATL_INDEX(NN))
      IF (ML%N_REACTIONS>0 .AND. SF%TMP_IGN<5000._EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)// ' cannot have a REACting MATL and IGNITION_TEMPERATURE'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO

   ! Specified source term

   IF (SF%N_LAYERS>0 .AND. SF%LAYER_DENSITY(1)>0._EB) THEN
      SF%INTERNAL_HEAT_SOURCE(1:SF%N_LAYERS) = 1000._EB*INTERNAL_HEAT_SOURCE(1:SF%N_LAYERS)
      IF (MAXVAL(ABS(SF%INTERNAL_HEAT_SOURCE)) > TWO_EPSILON_EB) SF%SPECIFIED_HEAT_SOURCE = .TRUE.
   ENDIF

   ! Thermal boundary conditions

   IF (SF%ADIABATIC .AND. (SF%NET_HEAT_FLUX < 1.E12_EB .OR. ABS(SF%CONVECTIVE_HEAT_FLUX)>TWO_EPSILON_EB)) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//&
                                 ' cannot have both ADIABATIC and NET_HEAT_FLUX or CONVECTIVE_HEAT_FLUX'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (SF%NET_HEAT_FLUX < 1.E12_EB .AND. ABS(SF%CONVECTIVE_HEAT_FLUX)>TWO_EPSILON_EB) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)// ' cannot have both NET_HEAT_FLUX or CONVECTIVE_HEAT_FLUX'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF ((SF%NET_HEAT_FLUX < 1.E12_EB .OR. ABS(SF%CONVECTIVE_HEAT_FLUX)>TWO_EPSILON_EB) .AND. TMP_FRONT >= -TMPM) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)// ' cannot have TMP_FRONT with NET_HEAT_FLUX or CONVECTIVE_HEAT_FLUX'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (HT3D) THEN
      IF ( SF%NET_HEAT_FLUX < 1.E12_EB .OR. ABS(SF%CONVECTIVE_HEAT_FLUX) > TWO_EPSILON_EB .OR. TMP_FRONT >= -TMPM ) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)// ' cannot have HT3D with specified TMP or FLUX bc'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF

   SF%THERMAL_BC_INDEX = SPECIFIED_TEMPERATURE  ! Default thermal boundary condition

   IF (SF%ADIABATIC) THEN
      SF%THERMAL_BC_INDEX = NET_FLUX_BC
      SF%NET_HEAT_FLUX = 0._EB
      SF%EMISSIVITY = 1._EB
   ENDIF
   IF (SF%NET_HEAT_FLUX < 1.E12_EB)                 SF%THERMAL_BC_INDEX = NET_FLUX_BC
   IF (ABS(SF%CONVECTIVE_HEAT_FLUX)>TWO_EPSILON_EB) SF%THERMAL_BC_INDEX = CONVECTIVE_FLUX_BC
   IF (THERM_THICK)                                 SF%THERMAL_BC_INDEX = THERMALLY_THICK
   IF (HT3D)                                        SF%THERMAL_BC_INDEX = THERMALLY_THICK_HT3D
   IF (SF%PROFILE==ATMOSPHERIC_PROFILE)             SF%THERMAL_BC_INDEX = INFLOW_OUTFLOW

   ! Boundary layer profile

   IF (SF%PROFILE==BOUNDARY_LAYER_PROFILE) THEN
      IF ( ABS(VEL_BULK)>ABS(VEL) ) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)// ' VEL_BULK invalid, must have VEL_BULK <= VEL'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF

   ! Set convection length scale automatically for spheres. Set to 1 m for everything else.

   IF (SF%CONV_LENGTH<0._EB) THEN
      SELECT CASE(SF%GEOMETRY)
         CASE(SURF_SPHERICAL)
            SF%CONV_LENGTH = 2._EB*(SF%INNER_RADIUS+SF%THICKNESS)
         CASE(SURF_CYLINDRICAL)
            SF%CONV_LENGTH = 2._EB*SF%THICKNESS
         CASE DEFAULT
            SF%CONV_LENGTH = 1._EB
      END SELECT
   ENDIF

   ! Ramps

   IF (SF%RAMP_Q/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_Q,'TIME',NR)
      SF%RAMP_INDEX(TIME_HEAT) = NR
   ELSE
      IF (SF%TAU(TIME_HEAT) > 0._EB) SF%RAMP_INDEX(TIME_HEAT) = TANH_RAMP
      IF (SF%TAU(TIME_HEAT) < 0._EB) SF%RAMP_INDEX(TIME_HEAT) = TSQR_RAMP
   ENDIF

   IF (SF%RAMP_V/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_V,'TIME',NR)
      SF%RAMP_INDEX(TIME_VELO) = NR
   ELSE
      IF (SF%TAU(TIME_VELO) > 0._EB) SF%RAMP_INDEX(TIME_VELO) = TANH_RAMP
      IF (SF%TAU(TIME_VELO) < 0._EB) SF%RAMP_INDEX(TIME_VELO) = TSQR_RAMP
   ENDIF

   IF (SF%RAMP_T/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_T,'TIME',NR)
      SF%RAMP_INDEX(TIME_TEMP) = NR
   ELSE
      IF (SF%TAU(TIME_TEMP) > 0._EB) SF%RAMP_INDEX(TIME_TEMP) = TANH_RAMP
      IF (SF%TAU(TIME_TEMP) < 0._EB) SF%RAMP_INDEX(TIME_TEMP) = TSQR_RAMP
   ENDIF

   IF (SF%RAMP_T_B/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_T_B,'TIME',NR)
      SF%RAMP_T_B_INDEX = NR
   ENDIF

   IF (SF%RAMP_T_I/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_T_I,'TIME',NR)
      SF%RAMP_T_I_INDEX = NR
   ENDIF

   IF (SF%RAMP_EF/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_EF,'TIME',NR)
      SF%RAMP_INDEX(TIME_EFLUX) = NR
   ELSE
      IF (SF%TAU(TIME_EFLUX) > 0._EB) SF%RAMP_INDEX(TIME_EFLUX) = TANH_RAMP
      IF (SF%TAU(TIME_EFLUX) < 0._EB) SF%RAMP_INDEX(TIME_EFLUX) = TSQR_RAMP
   ENDIF

   IF (SF%RAMP_PART/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_PART,'TIME',NR)
      SF%RAMP_INDEX(TIME_PART) = NR
   ELSE
      IF (SF%TAU(TIME_PART) > 0._EB) SF%RAMP_INDEX(TIME_PART) = TANH_RAMP
      IF (SF%TAU(TIME_PART) < 0._EB) SF%RAMP_INDEX(TIME_PART) = TSQR_RAMP
   ENDIF

   IF (SF%RAMP_V_X/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_V_X,'PROFILE',NR)
      SF%RAMP_INDEX(VELO_PROF_X) = NR
   ENDIF

   IF (SF%RAMP_V_Y/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_V_Y,'PROFILE',NR)
      SF%RAMP_INDEX(VELO_PROF_Y) = NR
   ENDIF

   IF (SF%RAMP_V_Z/='null') THEN
      CALL GET_RAMP_INDEX(SF%RAMP_V_Z,'PROFILE',NR)
      SF%RAMP_INDEX(VELO_PROF_Z) = NR
   ENDIF

   ! Count the number of Full Spectrum K-distribution (FSK) quadrature points
   SF%NUMBER_FSK_POINTS = 0
   DO I = 1,MAX_NUMBER_FSK_POINTS
      IF (SF%FSK_W(I) > TWO_EPSILON_EB) SF%NUMBER_FSK_POINTS = SF%NUMBER_FSK_POINTS + 1
   ENDDO

   ! Set mass transfer parameters and variables
   IF (SF%MT1D) THEN
      SF%N_SPEC = N_TRACKED_SPECIES
   ENDIF

ENDDO READ_SURF_LOOP

CONTAINS

SUBROUTINE SET_SURF_DEFAULTS

ABL_MODEL               = .FALSE.
ADIABATIC               = .FALSE.
AREA_MULTIPLIER         = 1._EB
BACKING                 = 'EXPOSED'
BLOWING                 = .FALSE.
BLOWING_2               = .FALSE.
BURN_AWAY               = .FALSE.
BURN_DURATION           = 1.E6_EB
CELL_SIZE_FACTOR        = 1.0
C_FORCED_CONSTANT       = 0._EB
C_FORCED_PR_EXP         = 0._EB
C_FORCED_RE             = 0._EB
C_FORCED_RE_EXP         = 0._EB
C_VERTICAL              = 1.31_EB  ! Vertical free convection (Holman, Table 7-2)
C_HORIZONTAL            = 1.52_EB  ! Horizontal free convection
COLOR                   = 'null'
CONE_HEAT_FLUX               = -1._EB
CONVECTIVE_HEAT_FLUX    = 0._EB
CONVECTION_LENGTH_SCALE = -1._EB
CONVERT_VOLUME_TO_MASS  = .FALSE.
DELTA_TMP_MAX           = 10._EB
NET_HEAT_FLUX           = 1.E12_EB
DEFAULT                 = .FALSE.
DT_INSERT               = 0.01_EB
DUCT_PATH               = 0
E_COEFFICIENT           = 0._EB
EMISSIVITY              = -1._EB
EMISSIVITY_DEFAULT      = 0.9_EB
EMISSIVITY_BACK         = -1._EB
EVAC_DEFAULT            = .FALSE.
EXTERNAL_FLUX           = 0._EB
EXTERNAL_FLUX_RAMP      = 'null'
EXTINCTION_TEMPERATURE  = -273._EB
FREE_SLIP               = .FALSE.
FSK_K                   = 0._EB
FSK_A                   = 1._EB
FSK_W                   = 0._EB
NO_SLIP                 = .FALSE.
FYI                     = 'null'
GEOMETRY                = 'CARTESIAN'
HEAT_OF_VAPORIZATION    = 0._EB
HEAT_TRANSFER_MODEL     = 'null'
HEAT_TRANSFER_COEFFICIENT = -1._EB
HEAT_TRANSFER_COEFFICIENT_BACK = -1._EB
MASS_TRANSFER_COEFFICIENT = -1._EB
HRRPUA                  = 0._EB
HT3D                    = .FALSE.
ID                      = 'null'
IGNITION_TEMPERATURE    = 5000._EB
IMPERMEABLE             = .FALSE.
INNER_RADIUS            =  0._EB
INTERNAL_HEAT_SOURCE    = 0._EB
LAYER_DIVIDE            = -1._EB
LEAK_PATH               = -1
LEAK_PATH_ID            = 'null'
LENGTH                  = -1._EB
MASS_FLUX               = 0._EB
MASS_FLUX_TOTAL         = 0._EB
MASS_FLUX_VAR           = -1._EB
MASS_FRACTION           = 0._EB
MASS_TRANSFER           = .FALSE.
MATL_ID                 = 'null'
MATL_MASS_FRACTION      = 0._EB
MATL_MASS_FRACTION(:,1) = 1._EB
MINIMUM_BURNOUT_TIME    = 1.E6_EB
MOISTURE_FRACTION       = 0._EB
SURFACE_VOLUME_RATIO    = -1._EB
PACKING_RATIO           = -1._EB
DRAG_COEFFICIENT        = 2.8_EB
SHAPE_FACTOR            = 0.25_EB
MAX_PRESSURE            = 1.E12_EB
MINIMUM_LAYER_THICKNESS = 1.E-6_EB
MLRPUA                  = 0._EB
N_LAYER_CELLS_MAX       = 999
NPPC                    = 1
SUBSTEP_POWER           = 2
PARTICLE_MASS_FLUX      = 0._EB
PARTICLE_SURFACE_DENSITY= -1._EB
PART_ID                 = 'null'
PLE                     = 0.3_EB
PROFILE                 = 'null'
RADIUS                  = -1._EB
RAMP_MF                 = 'null'
RAMP_Q                  = 'null'
RAMP_V                  = 'null'
RAMP_T                  = 'null'
RAMP_T_B                = 'null'
RAMP_T_I                = 'null'
RAMP_PART               = 'null'
RAMP_V_X                = 'null'
RAMP_V_Y                = 'null'
RAMP_V_Z                = 'null'
RGB                     = -1
IF (SIM_MODE==DNS_MODE) THEN
   ROUGHNESS = 0._EB
ELSE
   ROUGHNESS = -1._EB !4.5E-5_EB  ! meters, commercial steel
ENDIF
SPEC_ID                 = 'null'
SPREAD_RATE             = -1._EB
STRETCH_FACTOR          = 2._EB
TAU_MF                  = TAU_DEFAULT
TAU_Q                   = TAU_DEFAULT
TAU_V                   = TAU_DEFAULT
TAU_T                   = TAU_DEFAULT
TAU_PART                = TAU_DEFAULT
TAU_EXTERNAL_FLUX       = 0.001_EB
TEXTURE_MAP             = 'null'
TEXTURE_WIDTH           = 1._EB
TEXTURE_HEIGHT          = 1._EB
TGA_ANALYSIS            = .FALSE.
THICKNESS               = -1._EB
TMP_BACK                = -TMPM-1._EB
TMP_FRONT               = -TMPM-1._EB
TMP_INNER               = -TMPM-1._EB
TRANSPARENCY            = 1._EB
VEL                     = 0._EB
VEL_BULK                = 0._EB
VEL_GRAD                = -999999._EB
VEL_T                   = 0._EB
VOLUME_FLUX             = 0._EB ! deprecated
VOLUME_FLOW             = 0._EB
WIDTH                   = -1._EB
XYZ                     = -1.E6_EB
Z0                      = 10._EB ! reference height (m)
Z_0                     = -1._EB ! aerodynamic roughness (m)

VEG_LSET_IGNITE_TIME    = 1.E9_EB
VEG_LSET_ROS_00         = 0.0_EB
VEG_LSET_ROS_HEAD       = 0.0_EB
VEG_LSET_ROS_FLANK      = 0.0_EB
VEG_LSET_ROS_BACK       = 0.0_EB
VEG_LSET_WIND_EXP       = 1.0_EB
VEG_LSET_TAN2           = .FALSE.
VEG_LSET_HT             = 1.0_EB
VEG_LSET_BETA           = 0.01_EB
VEG_LSET_SIGMA          = 5000.0_EB
VEG_LSET_QCON           = 0.0_EB
VEG_LSET_M1             = 0.03_EB
VEG_LSET_M10            = 0.04_EB
VEG_LSET_M100           = 0.05_EB
VEG_LSET_MLW            = 0.70_EB
VEG_LSET_MLH            = 0.70_EB
VEG_LSET_FUEL_INDEX     = 0
VEG_LSET_SURF_LOAD      = 0.3_EB !kg/m^2
VEG_LSET_FIREBASE_TIME  = -1.0_EB
VEG_LSET_CHAR_FRACTION  = 0.20_EB

END SUBROUTINE SET_SURF_DEFAULTS

END SUBROUTINE READ_SURF


!> \brief Process the SURF parameters

SUBROUTINE PROC_SURF_1

USE MATH_FUNCTIONS, ONLY : GET_RAMP_INDEX
INTEGER :: N,NSPC,NR,ILPC
TYPE (LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC=>NULL()

PROCESS_SURF_LOOP: DO N=0,N_SURF

   SF => SURFACE(N)

   ! Get ramps for the surface mass fraction and flux

   DO NSPC=1,N_TRACKED_SPECIES
      IF (TRIM(SF%RAMP_MF(NSPC))/='null') THEN
         CALL GET_RAMP_INDEX(SF%RAMP_MF(NSPC),'TIME',NR)
         SF%RAMP_INDEX(NSPC) = NR
      ELSE
         IF (SF%TAU(NSPC) > 0._EB) SF%RAMP_INDEX(NSPC) = TANH_RAMP
         IF (SF%TAU(NSPC) < 0._EB) SF%RAMP_INDEX(NSPC) = TSQR_RAMP
      ENDIF
   ENDDO


   IF (ANY(SF%LEAK_PATH_ID/='null'))  THEN

      IF(SF%LEAK_PATH_ID(1)=='AMBIENT') SF%LEAK_PATH(1)=0
      IF(SF%LEAK_PATH_ID(2)=='AMBIENT') SF%LEAK_PATH(2)=0
      ZONE_LOOP: DO NR = 1, N_ZONE
         IF(TRIM(SF%LEAK_PATH_ID(1))==TRIM(P_ZONE(NR)%ID)) SF%LEAK_PATH(1) = NR
         IF(TRIM(SF%LEAK_PATH_ID(2))==TRIM(P_ZONE(NR)%ID)) SF%LEAK_PATH(2) = NR
         IF(SF%LEAK_PATH(1) >=0 .AND. SF%LEAK_PATH(2)>=0) EXIT ZONE_LOOP
      ENDDO ZONE_LOOP

      IF (SF%LEAK_PATH(1)==-1) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' ZONE ID for LEAK_PATH_ID(1) not found'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (SF%LEAK_PATH(2)==-1) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' ZONE ID for LEAK_PATH_ID(2) not found'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

   ENDIF

   IF (SF%LEAK_PATH(2) < SF%LEAK_PATH(1)) THEN
      ILPC = SF%LEAK_PATH(2)
      SF%LEAK_PATH(2)      = SF%LEAK_PATH(1)
      SF%LEAK_PATH(1)      = ILPC
   ENDIF

   IF (SF%LEAK_PATH(1)==SF%LEAK_PATH(2) .AND. SF%LEAK_PATH(1)>=0) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' Cannot set the same ZONE for each leakage path.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   IF (SF%LEAK_PATH(1)>N_ZONE .OR. SF%LEAK_PATH(2)>N_ZONE) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' LEAK_PATH greater than number of ZONEs.'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Look for particle classes that use SURF for property info

   DO ILPC=1,N_LAGRANGIAN_CLASSES

      LPC=>LAGRANGIAN_PARTICLE_CLASS(ILPC)

      IF (LPC%SURF_ID==SF%ID) THEN
         LPC%SURF_INDEX = N

         IF (.NOT.LPC%SOLID_PARTICLE) CYCLE

         IF (LPC%DRAG_LAW==SCREEN_DRAG) THEN
            IF (LPC%SHAPE_FACTOR<0._EB) LPC%SHAPE_FACTOR = 1._EB/PI
            CYCLE
         ENDIF

         SELECT CASE (SF%GEOMETRY)
            CASE(SURF_CARTESIAN)
               IF (LPC%SHAPE_FACTOR<0._EB) LPC%SHAPE_FACTOR = 0.5_EB
               IF (SF%THICKNESS<=0._EB) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' needs a THICKNESS'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               IF (.NOT. LPC%DRAG_LAW==POROUS_DRAG) THEN
                  IF (SF%LENGTH<=0._EB) THEN
                     WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' needs a LENGTH'
                     CALL SHUTDOWN(MESSAGE) ; RETURN
                  ENDIF
                  IF (SF%WIDTH<=0._EB) THEN
                     WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' needs a WIDTH'
                     CALL SHUTDOWN(MESSAGE) ; RETURN
                  ENDIF
               ENDIF
            CASE(SURF_CYLINDRICAL)
               IF (LPC%SHAPE_FACTOR<0._EB) LPC%SHAPE_FACTOR = 1._EB/PI
               IF (.NOT. LPC%DRAG_LAW==POROUS_DRAG) THEN
                  IF (SF%LENGTH <0._EB) THEN
                     WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' needs a LENGTH'
                     CALL SHUTDOWN(MESSAGE) ; RETURN
                  ENDIF
               ENDIF
            CASE(SURF_SPHERICAL)
               IF (LPC%SHAPE_FACTOR<0._EB) LPC%SHAPE_FACTOR = 0.25_EB
         END SELECT
      ENDIF
   ENDDO

ENDDO PROCESS_SURF_LOOP

! If a particle class uses a SURF line, make sure the SURF ID exists

DO ILPC=1,N_LAGRANGIAN_CLASSES
   LPC=>LAGRANGIAN_PARTICLE_CLASS(ILPC)
   IF (LPC%SURF_INDEX<0) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(LPC%SURF_ID),' not found'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDDO

END SUBROUTINE PROC_SURF_1


!> \brief Process the SURF parameters

SUBROUTINE PROC_SURF_2

INTEGER :: ILPC,N,NN,NNN,NL,I_CONE_RAMP=0, NR
REAL(EB) :: ADJUSTED_LAYER_DENSITY,R_L(0:MAX_LAYERS)
INTEGER  :: I_FUEL,I_GRAD
LOGICAL :: BURNING,BLOWING,SUCKING
TYPE(RAMPS_TYPE),POINTER :: RP=>NULL(),RP2=>NULL()

TYPE(LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC=>NULL()

PROCESS_SURF_LOOP: DO N=0,N_SURF

   SF => SURFACE(N)
   IF (SF%THERMAL_BC_INDEX==THERMALLY_THICK) ML=>MATERIAL(SF%LAYER_MATL_INDEX(1,1))

   SELECT CASE(SF%GEOMETRY)
      CASE(SURF_CARTESIAN)    ; I_GRAD = 1
      CASE(SURF_CYLINDRICAL)  ; I_GRAD = 2
      CASE(SURF_SPHERICAL)    ; I_GRAD = 3
   END SELECT

   ! Particle Information

   SF%PART_INDEX = 0
   IF (SF%PART_ID/='null') THEN
      DO ILPC=1,N_LAGRANGIAN_CLASSES
         LPC=>LAGRANGIAN_PARTICLE_CLASS(ILPC)
         IF (LPC%ID==SF%PART_ID)  SF%PART_INDEX = ILPC
      ENDDO
      IF (SF%PART_INDEX==0) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: PART_ID '//TRIM(SF%PART_ID)//' not found'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      PARTICLE_FILE=.TRUE.
   ENDIF

   ! Determine if surface has internal radiation

   SF%INTERNAL_RADIATION = .FALSE.
   DO NL=1,SF%N_LAYERS
      IF (SF%KAPPA_S(NL)>0._EB) SF%INTERNAL_RADIATION = .TRUE.
      DO NN =1,SF%N_LAYER_MATL(NL)
         ML => MATERIAL(SF%LAYER_MATL_INDEX(NL,NN))
         IF (ML%KAPPA_S<5.0E4_EB) SF%INTERNAL_RADIATION = .TRUE.
      ENDDO
   ENDDO

   ! Internal radiation only allowed for Cartesian geometry

   IF (SF%INTERNAL_RADIATION .AND. .NOT.SF%GEOMETRY==SURF_CARTESIAN) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),&
                               ' is not Cartesian and cannot have a material with an ABSORPTION_COEFFICIENT'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! In case of internal radiation, do not allow zero-emissivity

   IF (SF%INTERNAL_RADIATION) THEN
      DO NL=1,SF%N_LAYERS
         DO NN =1,SF%N_LAYER_MATL(NL)
            ML => MATERIAL(SF%LAYER_MATL_INDEX(NL,NN))
            IF (ML%EMISSIVITY == 0._EB) THEN
               WRITE(MESSAGE,'(A)') 'ERROR: Zero emissivity of MATL '//TRIM(MATL_NAME(SF%LAYER_MATL_INDEX(NL,NN)))// &
               ' is inconsistent with internal radiation in SURF '//TRIM(SF%ID)//'.'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDDO
      ENDDO
   ENDIF

   ! Determine if the surface is combustible/burning.

   SF%PYROLYSIS_MODEL = PYROLYSIS_NONE
   BURNING  = .FALSE.
   DO NL=1,SF%N_LAYERS
      DO NN=1,SF%N_LAYER_MATL(NL)
         NNN = SF%LAYER_MATL_INDEX(NL,NN)
         ML => MATERIAL(NNN)
         IF (ML%PYROLYSIS_MODEL/=PYROLYSIS_NONE) THEN
            SF%PYROLYSIS_MODEL = PYROLYSIS_PREDICTED
            IF (N_REACTIONS>0) THEN
               IF (REACTION(1)%FUEL_SMIX_INDEX>=0) THEN
                  IF (ANY(ML%NU_SPEC(REACTION(1)%FUEL_SMIX_INDEX,:)>0._EB))  THEN
                     BURNING = .TRUE.
                     SF%TAU(TIME_HEAT) = 0._EB
                  ENDIF
               ENDIF
            ENDIF
         ENDIF
      ENDDO
   ENDDO

   IF (SF%HRRPUA>0._EB .OR. SF%MLRPUA>0._EB) THEN
      IF (SF%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' has a specified HRRPUA or MLRPUA plus another pyrolysis model'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (N_REACTIONS > 1 .AND. .NOT.SIMPLE_CHEMISTRY) THEN
         WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' has HRRPUA or MLRPUA set and there is more than one reaction'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      BURNING = .TRUE.
      SF%PYROLYSIS_MODEL = PYROLYSIS_SPECIFIED
   ENDIF

   IF (BURNING .AND. N_REACTIONS==0) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' indicates burning, but there is no REAC line'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Make decisions based on whether there is forced ventilation at the surface

   BLOWING  = .FALSE.
   SUCKING  = .FALSE.
   IF (SF%VEL<0._EB .OR. SF%VOLUME_FLOW<0._EB .OR. SF%MASS_FLUX_TOTAL < 0._EB) BLOWING = .TRUE.
   IF (SF%VEL>0._EB .OR. SF%VOLUME_FLOW>0._EB .OR. SF%MASS_FLUX_TOTAL > 0._EB) SUCKING = .TRUE.
   IF (BLOWING .OR. SUCKING) SF%SPECIFIED_NORMAL_VELOCITY = .TRUE.
   IF (SUCKING) SF%FREE_SLIP = .TRUE.

   IF (BURNING .AND. (BLOWING .OR. SUCKING)) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' cannot have a specified velocity or volume flux'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Neumann for normal component of velocity

   IF (SF%VEL_GRAD > -999998._EB) THEN
       SF%SPECIFIED_NORMAL_GRADIENT = .TRUE.
       SF%SPECIFIED_NORMAL_VELOCITY = .FALSE.
   ENDIF

   ! Set predefined HRRPUA

   BURNING_IF: IF (BURNING .AND. .NOT.ALL(EVACUATION_ONLY)) THEN
      RN => REACTION(1)
      I_FUEL = RN%FUEL_SMIX_INDEX
      IF (SF%N_LAYERS > 0 .AND. SF%THERMAL_BC_INDEX==THERMALLY_THICK) &
         SF%ADJUST_BURN_RATE(I_FUEL) = MATERIAL(SF%MATL_INDEX(1))%ADJUST_BURN_RATE(I_FUEL,1)
      IF (SF%HRRPUA>0._EB) SF%MASS_FLUX(I_FUEL) = SF%HRRPUA/RN%HOC_COMPLETE/SF%ADJUST_BURN_RATE(I_FUEL)
      IF (SF%MLRPUA>0._EB) SF%MASS_FLUX(I_FUEL) = SF%MLRPUA
      SF%TAU(I_FUEL)        = SF%TAU(TIME_HEAT)
      SF%RAMP_MF(I_FUEL)    = SF%RAMP_Q
      SF%RAMP_INDEX(I_FUEL) = SF%RAMP_INDEX(TIME_HEAT)
   ENDIF BURNING_IF

   ! Compute surface density

   SF%SURFACE_DENSITY = 0._EB
   R_L(0) = SF%THICKNESS
   DO NL=1,SF%N_LAYERS
      ADJUSTED_LAYER_DENSITY = 0._EB
      MATL_LOOP:DO NN=1,SF%N_LAYER_MATL(NL)
         NNN = SF%LAYER_MATL_INDEX(NL,NN)
         ML => MATERIAL(NNN)
         ADJUSTED_LAYER_DENSITY = ADJUSTED_LAYER_DENSITY + SF%LAYER_MATL_FRAC(NL,NN)/ML%RHO_S
      ENDDO MATL_LOOP
      IF (ADJUSTED_LAYER_DENSITY > 0._EB) ADJUSTED_LAYER_DENSITY = 1./ADJUSTED_LAYER_DENSITY
      R_L(NL) = R_L(NL-1)-SF%LAYER_THICKNESS(NL)
      SF%SURFACE_DENSITY = SF%SURFACE_DENSITY + ADJUSTED_LAYER_DENSITY * &
         (R_L(NL-1)**I_GRAD-R_L(NL)**I_GRAD)/(REAL(I_GRAD,EB)*SF%THICKNESS**(I_GRAD-1))
   ENDDO

   IF ((ABS(SF%SURFACE_DENSITY) <= TWO_EPSILON_EB) .AND. SF%BURN_AWAY) THEN
      WRITE(MESSAGE,'(A,A,A)') 'WARNING: SURF ',TRIM(SF%ID),' has BURN_AWAY set but zero combustible density'
      IF (MYID==0) WRITE(LU_ERR,'(A)') TRIM(MESSAGE)
   ENDIF

   ! Ignition Time

   SF%T_IGN = T_BEGIN
   IF (SF%TMP_IGN<5000._EB)                     SF%T_IGN = HUGE(T_END)
   IF (SF%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED) SF%T_IGN = HUGE(T_END)
   IF (SF%VEG_LSET_SPREAD)                      SF%T_IGN = HUGE(T_END)

   ! Species Arrays and Method of Mass Transfer (SPECIES_BC_INDEX)

   SF%SPECIES_BC_INDEX = NO_MASS_FLUX

   IF (ANY(SF%MASS_FRACTION>0._EB) .AND. (ANY(ABS(SF%MASS_FLUX)>TWO_EPSILON_EB) .OR. SF%PYROLYSIS_MODEL/= PYROLYSIS_NONE)) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' cannot specify mass fraction with mass flux and/or pyrolysis'
      CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   IF (ANY(SF%MASS_FRACTION>0._EB) .AND. SUCKING) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' cannot specify both mass fraction and outflow velocity'
      CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   IF (ANY(SF%LEAK_PATH>=0) .AND. (BLOWING .OR. SUCKING .OR. SF%PYROLYSIS_MODEL/= PYROLYSIS_NONE)) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' cannot leak and specify flow or pyrolysis at the same time'
      CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   IF (ANY(ABS(SF%MASS_FLUX)>TWO_EPSILON_EB) .AND. (BLOWING .OR. SUCKING)) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: SURF '//TRIM(SF%ID)//' cannot have both a mass flux and specified velocity'
      CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

   IF (BLOWING .OR. SUCKING)        SF%SPECIES_BC_INDEX = SPECIFIED_MASS_FRACTION
   IF (ANY(SF%MASS_FRACTION>0._EB)) SF%SPECIES_BC_INDEX = SPECIFIED_MASS_FRACTION
   IF (ANY(ABS(SF%MASS_FLUX)>TWO_EPSILON_EB) .OR. &
       SF%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED) SF%SPECIES_BC_INDEX = SPECIFIED_MASS_FLUX

   IF (SF%SPECIES_BC_INDEX==SPECIFIED_MASS_FRACTION) THEN
      IF (ALL(ABS(SF%MASS_FRACTION)< TWO_EPSILON_EB)) &
         SF%MASS_FRACTION(1:N_TRACKED_SPECIES) = SPECIES_MIXTURE(1:N_TRACKED_SPECIES)%ZZ0
   ENDIF

   ! Texture map info

   SF%SURF_TYPE = 0
   IF (SF%TEXTURE_MAP/='null') SF%SURF_TYPE = 1

   ! Set BCs for various boundary types

   SF%VELOCITY_BC_INDEX = WALL_MODEL_BC
   IF (SIM_MODE==DNS_MODE)     SF%VELOCITY_BC_INDEX = NO_SLIP_BC
   IF (SF%FREE_SLIP)           SF%VELOCITY_BC_INDEX = FREE_SLIP_BC
   IF (SF%NO_SLIP)             SF%VELOCITY_BC_INDEX = NO_SLIP_BC
   IF (SF%BOUNDARY_FUEL_MODEL) SF%VELOCITY_BC_INDEX = BOUNDARY_FUEL_MODEL_BC

   IF (N==OPEN_SURF_INDEX) THEN
      SF%THERMAL_BC_INDEX = INFLOW_OUTFLOW
      SF%SPECIES_BC_INDEX = INFLOW_OUTFLOW_MASS_FLUX
      SF%VELOCITY_BC_INDEX = FREE_SLIP_BC
      SF%SURF_TYPE = 2
      SF%EMISSIVITY = 1._EB
   ENDIF
   IF (N==MIRROR_SURF_INDEX) THEN
      SF%THERMAL_BC_INDEX = NO_CONVECTION
      SF%SPECIES_BC_INDEX = NO_MASS_FLUX
      SF%VELOCITY_BC_INDEX = FREE_SLIP_BC
      SF%SURF_TYPE = -2
      SF%EMISSIVITY = 0._EB
   ENDIF
   IF (N==INTERPOLATED_SURF_INDEX) THEN
      SF%THERMAL_BC_INDEX = INTERPOLATED_BC
      SF%SPECIES_BC_INDEX = INTERPOLATED_BC
      SF%VELOCITY_BC_INDEX = INTERPOLATED_VELOCITY_BC
   ENDIF
   IF (N==PERIODIC_SURF_INDEX) THEN
      SF%THERMAL_BC_INDEX = INTERPOLATED_BC
      SF%SPECIES_BC_INDEX = INTERPOLATED_BC
      SF%VELOCITY_BC_INDEX = INTERPOLATED_VELOCITY_BC
   ENDIF
   IF (N==PERIODIC_FLOW_ONLY_SURF_INDEX) THEN
      SF%THERMAL_BC_INDEX = INFLOW_OUTFLOW
      SF%SPECIES_BC_INDEX = INFLOW_OUTFLOW_MASS_FLUX
      SF%VELOCITY_BC_INDEX = INTERPOLATED_VELOCITY_BC
   ENDIF
   IF (N==HVAC_SURF_INDEX) THEN
      SF%THERMAL_BC_INDEX = HVAC_BOUNDARY
      SF%SPECIES_BC_INDEX = HVAC_BOUNDARY
   ENDIF
   IF (N==MASSLESS_TRACER_SURF_INDEX) THEN
      SF%NRA = 1
      SF%NSB = 1
   ENDIF
   IF (N==DROPLET_SURF_INDEX) THEN
      SF%NRA = 1
      SF%NSB = 1
   ENDIF
   IF (N==EVACUATION_SURF_INDEX) THEN
      SF%THERMAL_BC_INDEX = INFLOW_OUTFLOW
      SF%SPECIES_BC_INDEX = SPECIFIED_MASS_FRACTION
      SF%SPECIFIED_NORMAL_VELOCITY = .TRUE.
      SF%FREE_SLIP = .TRUE.
      SF%VELOCITY_BC_INDEX = FREE_SLIP_BC
      SF%VEL                   = +0.000001_EB ! VEL
      SF%TAU(TIME_VELO)        = 0.1_EB ! TAU_V
      SF%RAMP_INDEX(TIME_VELO) = TANH_RAMP
   ENDIF
   IF (N==MASSLESS_TARGET_SURF_INDEX) THEN
      SF%EMISSIVITY = 1._EB
   ENDIF

   ! Do not allow N_LAYERS or N_CELLS_INI to be zero

   IF (.NOT.ALLOCATED(SF%N_LAYER_CELLS)) THEN
      SF%N_LAYERS     = 1
      SF%N_CELLS_MAX  = 1
      SF%N_CELLS_INI  = 1
      SF%N_MATL   = 1
      ALLOCATE(SF%N_LAYER_CELLS(SF%N_LAYERS))
      ALLOCATE(SF%X_S(0:SF%N_CELLS_MAX))
      SF%X_S(0) = 0._EB
      SF%X_S(1) = SF%THICKNESS
      ALLOCATE(SF%RHO_0(0:SF%N_CELLS_MAX+1,SF%N_MATL))
      SF%RHO_0 = 0._EB
      SF%TMP_INNER(:) = TMPA
   ENDIF

   ! Adjust RAMP_Q for CONE_HEAT_FLUX

   IF (SF%CONE_HEAT_FLUX >=0._EB) THEN
      I_CONE_RAMP = I_CONE_RAMP + 1
      NR = N_RAMP + I_CONE_RAMP
      RP => RAMPS(NR)
      RP2 => RAMPS(SF%RAMP_INDEX(REACTION(1)%FUEL_SMIX_INDEX))
      RP = RP2
      RP%INTERPOLATED_DATA(0) = 0._EB
      DO NN=1,RP%NUMBER_INTERPOLATION_POINTS
         RP%INTERPOLATED_DATA(NN) = 0.5_EB * (RP2%INTERPOLATED_DATA(NN) + RP2%INTERPOLATED_DATA(NN-1)) / RP2%RDT + &
                                   RP%INTERPOLATED_DATA(NN-1)
      ENDDO
      RP%INTERPOLATED_DATA(RP%NUMBER_INTERPOLATION_POINTS+1) = RP%INTERPOLATED_DATA(RP%NUMBER_INTERPOLATION_POINTS)
      SF%RAMP_INDEX(REACTION(1)%FUEL_SMIX_INDEX) = NR
   ENDIF

ENDDO PROCESS_SURF_LOOP

END SUBROUTINE PROC_SURF_2


! \brief Set up 1-D grids and arrays for thermally-thick solids

SUBROUTINE PROC_WALL

USE GEOMETRY_FUNCTIONS
USE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP
INTEGER :: SURF_INDEX,N,NL,II,IL,NN,N_CELLS_MAX
REAL(EB) :: K_S_0,C_S_0,SMALLEST_CELL_SIZE(MAX_LAYERS),SWELL_RATIO,DENSITY_MAX,DENSITY_MIN
LOGICAL :: PROC_SURF_GRID

! Calculate ambient temperature thermal DIFFUSIVITY for each MATERIAL, to be used in determining number of solid cells

DO N=1,N_MATL
   ML => MATERIAL(N)
   IF (ML%K_S>0._EB) THEN
      K_S_0 = ML%K_S
   ELSE
      K_S_0 = EVALUATE_RAMP(TMPA,0._EB,-NINT(ML%K_S))
   ENDIF
   IF (ML%C_S>0._EB) THEN
      C_S_0 = ML%C_S
   ELSE
      C_S_0 = EVALUATE_RAMP(TMPA,0._EB,-NINT(ML%C_S))
   ENDIF
   ML%THERMAL_DIFFUSIVITY = K_S_0/(C_S_0*ML%RHO_S)
ENDDO

NWP_MAX = 0  ! For some utility arrays, need to know the greatest number of points of all surface types

! Loop through all surfaces, looking for those that are thermally-thick (have layers).
! Compute smallest cell size for each layer such that internal cells double in size.
! Each layer should have an odd number of cells.

SURF_GRID_LOOP: DO SURF_INDEX=0,N_SURF

   PROC_SURF_GRID = .FALSE.
   SF => SURFACE(SURF_INDEX)
   IF (SF%THERMAL_BC_INDEX == THERMALLY_THICK) PROC_SURF_GRID = .TRUE.
   IF (SF%THERMAL_BC_INDEX == THERMALLY_THICK_HT3D .AND. SF%LAYER_THICKNESS(1)>TWO_EPSILON_EB) PROC_SURF_GRID = .TRUE.
   IF (.NOT.PROC_SURF_GRID) CYCLE SURF_GRID_LOOP

   ! Compute number of points per layer, and then sum up to get total points for the surface

   SF%N_CELLS_INI = 0
   N_CELLS_MAX    = 0

   LAYER_LOOP: DO NL=1,SF%N_LAYERS

      SF%MIN_DIFFUSIVITY(NL) = 1000000._EB
      DO N = 1,SF%N_LAYER_MATL(NL)
         ML => MATERIAL(SF%LAYER_MATL_INDEX(NL,N))
         SF%MIN_DIFFUSIVITY(NL) = MIN(SF%MIN_DIFFUSIVITY(NL),ML%THERMAL_DIFFUSIVITY)
      ENDDO

      DENSITY_MAX = 0._EB
      DENSITY_MIN = 10000000._EB
      DO N = 1,SF%N_MATL
         ML => MATERIAL(SF%MATL_INDEX(N))
         DO NN = 1,SF%N_LAYER_MATL(NL)
            IF ((ML%PYROLYSIS_MODEL==PYROLYSIS_SOLID.OR.ML%PYROLYSIS_MODEL==PYROLYSIS_VEGETATION) .AND. &
                 SF%LAYER_MATL_INDEX(NL,NN)==SF%MATL_INDEX(N)) THEN
               DENSITY_MAX = MAX(DENSITY_MAX,SF%LAYER_MATL_FRAC(NL,NN)*SF%LAYER_DENSITY(NL))
            ENDIF
         ENDDO
         DENSITY_MIN = MIN(DENSITY_MIN,ML%RHO_S)
      ENDDO

      SWELL_RATIO = 1._EB
      IF (SF%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED .AND. DENSITY_MIN>TWO_EPSILON_EB) SWELL_RATIO = DENSITY_MAX/DENSITY_MIN
      SWELL_RATIO = MAX(1.0_EB, SWELL_RATIO)

      ! Get highest possible number of cells for this layer

      CALL GET_N_LAYER_CELLS(SF%MIN_DIFFUSIVITY(NL),SWELL_RATIO*SF%LAYER_THICKNESS(NL),SF%STRETCH_FACTOR(NL), &
                          SF%CELL_SIZE_FACTOR,SF%N_LAYER_CELLS_MAX(NL),SF%N_LAYER_CELLS(NL),SMALLEST_CELL_SIZE(NL))
      N_CELLS_MAX = N_CELLS_MAX + SF%N_LAYER_CELLS(NL)

      ! Get initial number of cells for this layer

      CALL GET_N_LAYER_CELLS(SF%MIN_DIFFUSIVITY(NL),SF%LAYER_THICKNESS(NL),SF%STRETCH_FACTOR(NL), &
                             SF%CELL_SIZE_FACTOR,SF%N_LAYER_CELLS_MAX(NL),SF%N_LAYER_CELLS(NL),SMALLEST_CELL_SIZE(NL))
      SF%N_CELLS_INI= SF%N_CELLS_INI + SF%N_LAYER_CELLS(NL)

   ENDDO LAYER_LOOP

   IF (SF%N_CELLS_MAX==0) SF%N_CELLS_MAX = N_CELLS_MAX

   ! Allocate arrays to hold x_s, 1/dx_s (center to center, RDXN), 1/dx_s (edge to edge, RDX)

   NWP_MAX = MAX(NWP_MAX,SF%N_CELLS_MAX)
   ALLOCATE(SF%DX(1:SF%N_CELLS_MAX))
   ALLOCATE(SF%RDX(0:SF%N_CELLS_MAX+1))
   ALLOCATE(SF%RDXN(0:SF%N_CELLS_MAX))
   ALLOCATE(SF%DX_WGT(0:SF%N_CELLS_MAX))
   ALLOCATE(SF%X_S(0:SF%N_CELLS_MAX))
   ALLOCATE(SF%LAYER_INDEX(0:SF%N_CELLS_MAX+1))
   ALLOCATE(SF%MF_FRAC(1:SF%N_CELLS_MAX))
   ALLOCATE(SF%RHO_0(0:SF%N_CELLS_MAX+1,SF%N_MATL))

   ! Compute node coordinates

   CALL GET_WALL_NODE_COORDINATES(SF%N_CELLS_INI,SF%N_LAYERS,SF%N_LAYER_CELLS, &
         SMALLEST_CELL_SIZE(1:SF%N_LAYERS),SF%STRETCH_FACTOR(1:SF%N_LAYERS),SF%X_S)

   CALL GET_WALL_NODE_WEIGHTS(SF%N_CELLS_INI,SF%N_LAYERS,SF%N_LAYER_CELLS,SF%LAYER_THICKNESS,SF%GEOMETRY, &
         SF%X_S,SF%LAYER_DIVIDE,SF%DX,SF%RDX,SF%RDXN,SF%DX_WGT,SF%DXF,SF%DXB,SF%LAYER_INDEX,SF%MF_FRAC,SF%INNER_RADIUS)

   ! Initialize the material densities of the solid

   SF%RHO_0 = 0._EB

   DO II=0,SF%N_CELLS_INI+1
      IL = SF%LAYER_INDEX(II)
      IF (SF%TMP_INNER(IL)<=0._EB) SF%TMP_INNER(IL) = TMPA
      DO NN=1,SF%N_LAYER_MATL(IL)
         DO N=1,SF%N_MATL
            IF (SF%LAYER_MATL_INDEX(IL,NN)==SF%MATL_INDEX(N)) &
               SF%RHO_0(II,N) = SF%LAYER_MATL_FRAC(IL,NN)*SF%LAYER_DENSITY(IL)
         ENDDO
      ENDDO
   ENDDO

ENDDO SURF_GRID_LOOP

ALLOCATE(AAS(NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','AAS',IZERO)
ALLOCATE(CCS(NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','CCS',IZERO)
ALLOCATE(BBS(NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','BBS',IZERO)
ALLOCATE(DDS(NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','DDS',IZERO)
ALLOCATE(DDT(NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','DDT',IZERO)
ALLOCATE(Q_S(1:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','Q_S',IZERO)
ALLOCATE(RHO_S(0:NWP_MAX+1),STAT=IZERO)
CALL ChkMemErr('INIT','RHO_S',IZERO)
ALLOCATE(TWO_DX_KAPPA_S(1:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','TWO_DX_KAPPA_S',IZERO)
ALLOCATE(X_S_NEW(0:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','X_S_NEW',IZERO)
ALLOCATE(DX_S(1:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','DX_S',IZERO)
ALLOCATE(RDX_S(0:NWP_MAX+1),STAT=IZERO)
CALL ChkMemErr('INIT','RDX_S',IZERO)
ALLOCATE(RDXN_S(0:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','RDXN_S',IZERO)
ALLOCATE(R_S(0:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','R_S',IZERO)
ALLOCATE(R_S_NEW(0:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','R_S_NEW',IZERO)
ALLOCATE(DX_WGT_S(0:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','DX_WGT_S',IZERO)
ALLOCATE(LAYER_INDEX(0:NWP_MAX+1),STAT=IZERO)
CALL ChkMemErr('INIT','LAYER_INDEX',IZERO)
ALLOCATE(MF_FRAC(1:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','MF_FRAC',IZERO)
ALLOCATE(REGRID_FACTOR(1:NWP_MAX),STAT=IZERO)
CALL ChkMemErr('INIT','REGRID_FACTOR',IZERO)

END SUBROUTINE PROC_WALL


!> \brief Read the PRESsure namelist line

SUBROUTINE READ_PRES

USE SCRC, ONLY: SCARC_METHOD, SCARC_GRID, SCARC_MATRIX, SCARC_ERROR_FILE, SCARC_ACCURACY, SCARC_COARSENING, &
                SCARC_KRYLOV_ITERATIONS, SCARC_KRYLOV_ACCURACY, SCARC_KRYLOV_INTERPOL, &
                SCARC_MULTIGRID, SCARC_MULTIGRID_ITERATIONS, SCARC_MULTIGRID_ACCURACY, SCARC_TWOLEVEL, &
                SCARC_MULTIGRID_CYCLE, SCARC_MULTIGRID_LEVEL, SCARC_MULTIGRID_INTERPOL, SCARC_MULTIGRID_RELAXING, &
                SCARC_MULTIGRID_PRESMOOTH, SCARC_MULTIGRID_POSTSMOOTH, SCARC_MULTIGRID_THETA, SCARC_MKL_PRECISION, &
                SCARC_COARSE, SCARC_COARSE_ITERATIONS, SCARC_COARSE_ACCURACY, SCARC_COARSE_OMEGA, SCARC_COARSE_LEVEL, &
                SCARC_PRECON, SCARC_PRECON_SCOPE, SCARC_PRECON_ITERATIONS, SCARC_PRECON_ACCURACY, SCARC_PRECON_OMEGA, &
                SCARC_SMOOTH, SCARC_SMOOTH_SCOPE, SCARC_SMOOTH_ITERATIONS, SCARC_SMOOTH_ACCURACY, SCARC_SMOOTH_OMEGA

CHARACTER(LABEL_LENGTH) :: SOLVER='FFT'

NAMELIST /PRES/ BAROCLINIC,CHECK_POISSON,FISHPAK_BC,ITERATION_SUSPEND_FACTOR,LAPLACE_PRESSURE_CORRECTION, &
                SCARC_METHOD, SCARC_GRID, SCARC_MATRIX, SCARC_ERROR_FILE, SCARC_ACCURACY, SCARC_COARSENING, &
                SCARC_KRYLOV_ITERATIONS, SCARC_KRYLOV_ACCURACY, SCARC_KRYLOV_INTERPOL, &
                SCARC_MULTIGRID, SCARC_MULTIGRID_ITERATIONS, SCARC_MULTIGRID_ACCURACY, SCARC_TWOLEVEL, &
                SCARC_MULTIGRID_CYCLE, SCARC_MULTIGRID_LEVEL, SCARC_MULTIGRID_INTERPOL, SCARC_MULTIGRID_RELAXING, &
                SCARC_MULTIGRID_PRESMOOTH, SCARC_MULTIGRID_POSTSMOOTH, SCARC_MULTIGRID_THETA, SCARC_MKL_PRECISION, &
                SCARC_COARSE, SCARC_COARSE_ITERATIONS, SCARC_COARSE_ACCURACY, SCARC_COARSE_OMEGA, SCARC_COARSE_LEVEL, &
                SCARC_PRECON, SCARC_PRECON_SCOPE, SCARC_PRECON_ITERATIONS, SCARC_PRECON_ACCURACY, SCARC_PRECON_OMEGA, &
                SCARC_SMOOTH, SCARC_SMOOTH_SCOPE, SCARC_SMOOTH_ITERATIONS, SCARC_SMOOTH_ACCURACY, SCARC_SMOOTH_OMEGA, &
                MAX_PRESSURE_ITERATIONS,PRESSURE_RELAX_TIME,PRESSURE_TOLERANCE,RELAXATION_FACTOR, &
                SOLVER,SUSPEND_PRESSURE_ITERATIONS,VELOCITY_TOLERANCE

! Read the single PRES line

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
READ_LOOP: DO
   CALL CHECKREAD('PRES',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_LOOP
   READ(LU_INPUT,PRES,END=23,ERR=24,IOSTAT=IOS)
   24 IF (IOS>0) THEN
      CALL SHUTDOWN('ERROR: Problem with PRES line') ; RETURN
   ENDIF
ENDDO READ_LOOP
23 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! Given the chosen SOLVER, define internal variable PRES_METHOD:

SELECT CASE(TRIM(SOLVER))

   CASE('USCARC')
      PRES_METHOD = 'USCARC'
      PRES_ON_WHOLE_DOMAIN = .FALSE.
      IF (SCARC_METHOD == 'NONE') SCARC_METHOD = 'KRYLOV'    ! Use Krylov as default solver for USCARC
      IF (SCARC_PRECON == 'NONE') SCARC_PRECON = 'PARDISO'   ! Use PARDISO as default preconditioner for USCARC
      IF (SCARC_MATRIX == 'NONE') SCARC_MATRIX = 'COMPACT'   ! Use compact matrix storage technique

   CASE('SCARC')
      PRES_METHOD = 'SCARC'
      PRES_ON_WHOLE_DOMAIN = .TRUE.
      IF (SCARC_METHOD == 'NONE') SCARC_METHOD = 'KRYLOV'    ! Use Krylov default solver for SCARC
      IF (SCARC_PRECON == 'NONE') SCARC_PRECON = 'FFT'       ! Use FFT as default preconditioner for SCARC
      IF (SCARC_MATRIX == 'NONE') SCARC_MATRIX = 'BANDWISE'  ! Use bandwise matrix storage technique

   CASE('UGLMAT')
      PRES_METHOD = 'GLMAT'
      GLMAT_SOLVER = .TRUE.
      PRES_ON_WHOLE_DOMAIN = .FALSE.
      IF (CHECK_POISSON) GLMAT_VERBOSE=.TRUE.

   CASE('GLMAT')
      PRES_METHOD = 'GLMAT'
      GLMAT_SOLVER = .TRUE.
      PRES_ON_WHOLE_DOMAIN = .TRUE.
      IF (CHECK_POISSON) GLMAT_VERBOSE=.TRUE.

   CASE('FFT')
      ! Nothing to do. By default PRES_METHOD is set to 'FFT' in cons.f90
   CASE DEFAULT
      ! Here the user added an unknown name to SOLVER, stop:
      CALL SHUTDOWN('ERROR: Pressure solver '//TRIM(SOLVER)//' not known.') ; RETURN
END SELECT

! Determine how many pressure iterations to perform per half time step.

IF (VELOCITY_TOLERANCE>100._EB) THEN
   ITERATE_PRESSURE = .FALSE.
ELSE
   ITERATE_PRESSURE = .TRUE.
   IF (VELOCITY_TOLERANCE>TWO_EPSILON_EB .OR. PRESSURE_TOLERANCE>TWO_EPSILON_EB .OR. MAX_PRESSURE_ITERATIONS/=10) &
      SUSPEND_PRESSURE_ITERATIONS=.FALSE.
   IF (VELOCITY_TOLERANCE<TWO_EPSILON_EB) VELOCITY_TOLERANCE =  0.5_EB*CHARACTERISTIC_CELL_SIZE
   IF (PRESSURE_TOLERANCE<TWO_EPSILON_EB) PRESSURE_TOLERANCE = 20.0_EB/MIN(1._EB,CHARACTERISTIC_CELL_SIZE)**2
ENDIF

IF (NMESHES>1 .AND. ANY(FISHPAK_BC==FISHPAK_BC_PERIODIC)) THEN
   CALL SHUTDOWN('ERROR: Cannot use FISHPAK_BC_PERIODIC with NMESHES>1') ; RETURN
ENDIF

IF (ANY(FISHPAK_BC>0)) THEN
   CALL SHUTDOWN('ERROR: Cannot have FISHPAK_BC>0') ; RETURN
ENDIF

END SUBROUTINE READ_PRES


!> \brief Read the RADIation nameline line

SUBROUTINE READ_RADI

USE RADCONS
REAL(EB) :: BAND_LIMITS(MAX_NUMBER_SPECTRAL_BANDS+1)
LOGICAL :: OPTICALLY_THIN
NAMELIST /RADI/ ANGLE_INCREMENT,BAND_LIMITS,C_MAX,C_MIN,INITIAL_RADIATION_ITERATIONS,KAPPA0,&
                MIE_MINIMUM_DIAMETER,MIE_MAXIMUM_DIAMETER,MIE_NDG,NMIEANG,NUMBER_RADIATION_ANGLES,&
                OPTICALLY_THIN,PATH_LENGTH,QR_CLIP,RADIATION,RADIATION_ITERATIONS,RADTMP,&
                SOOT_DENSITY,TIME_STEP_INCREMENT,TRI_MODEL,WIDE_BAND_MODEL,WSGG_MODEL

REAL(EB) THETALOW,THETAUP
INTEGER  NRA,N

! Set default values

BAND_LIMITS(:) = -1._EB

INITIAL_RADIATION_ITERATIONS = 3
NUMBER_RADIATION_ANGLES = 100
TIME_STEP_INCREMENT     = 3
IF (TWO_D) THEN
   NUMBER_RADIATION_ANGLES = 60
   TIME_STEP_INCREMENT     = 2
ENDIF

KAPPA0               = -10._EB
RADTMP               = 900._EB
WIDE_BAND_MODEL      = .FALSE.
WSGG_MODEL           = .FALSE.
SOOT_DENSITY         = 1800._EB
NMIEANG              = 15
PATH_LENGTH          = -1.0_EB ! calculate path based on the geometry
ANGLE_INCREMENT      = -1
MIE_MAXIMUM_DIAMETER = 0._EB
MIE_MINIMUM_DIAMETER = 0._EB
MIE_NDG              = 50
QR_CLIP              = 10._EB  ! kW/m3, lower bound for radiation source correction
OPTICALLY_THIN       = .FALSE.

! Read radiation parameters

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
READ_LOOP: DO
   CALL CHECKREAD('RADI',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_LOOP
   READ(LU_INPUT,RADI,END=23,ERR=24,IOSTAT=IOS)
   24 IF (IOS>0) THEN
      CALL SHUTDOWN('ERROR: Problem with RADI line') ; RETURN
   ENDIF
ENDDO READ_LOOP
23 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! A few conversions

RADTMP = RADTMP + TMPM
QR_CLIP = QR_CLIP*1000._EB  ! kW/m3 to W/m3

! Optically-thin limit

IF (OPTICALLY_THIN .OR. KAPPA0==0._EB) RTE_SOURCE_CORRECTION = .FALSE.

! Define band parameters

IF (WIDE_BAND_MODEL) THEN
   WSGG_MODEL = .FALSE.
   NUMBER_SPECTRAL_BANDS = 6
   TIME_STEP_INCREMENT=MAX(1,TIME_STEP_INCREMENT)
   ANGLE_INCREMENT = 1
   UIIDIM=NUMBER_SPECTRAL_BANDS
ELSEIF (WSGG_MODEL) THEN
   WIDE_BAND_MODEL = .FALSE.
   NUMBER_SPECTRAL_BANDS = 5
   TIME_STEP_INCREMENT=MAX(1,TIME_STEP_INCREMENT)
   ANGLE_INCREMENT = 1
   UIIDIM=NUMBER_SPECTRAL_BANDS
ELSE
   NUMBER_SPECTRAL_BANDS = 1
   IF (ANGLE_INCREMENT < 0) ANGLE_INCREMENT = MAX(1,MIN(5,NUMBER_RADIATION_ANGLES/15))
   UIIDIM = ANGLE_INCREMENT
ENDIF

! Define custom wavelength band limits

IF (ANY(BAND_LIMITS>0._EB)) THEN
   NUMBER_SPECTRAL_BANDS = COUNT(BAND_LIMITS>0._EB) - 1
   IF (NUMBER_SPECTRAL_BANDS<2) THEN ; CALL SHUTDOWN('ERROR: Need more spectral band limits.') ; RETURN ; ENDIF
   IF (ANY((BAND_LIMITS(2:NUMBER_SPECTRAL_BANDS+1)-BAND_LIMITS(1:NUMBER_SPECTRAL_BANDS))<0._EB)) THEN
      CALL SHUTDOWN('ERROR: Spectral band limits should be given in ascending order.')
      RETURN
   ENDIF
   ALLOCATE(WL_HIGH(1:NUMBER_SPECTRAL_BANDS))
   ALLOCATE(WL_LOW(1:NUMBER_SPECTRAL_BANDS))
   DO I=1,NUMBER_SPECTRAL_BANDS
      WL_LOW(I) = BAND_LIMITS(I)
      WL_HIGH(I)= BAND_LIMITS(I+1)
   ENDDO

   TIME_STEP_INCREMENT=MAX(1,TIME_STEP_INCREMENT)
   ANGLE_INCREMENT = 1
   UIIDIM=NUMBER_SPECTRAL_BANDS
ENDIF

! Calculate actual number of radiation angles and determine the angular discretization

IF (.NOT.RADIATION) THEN

   NUMBER_RADIATION_ANGLES = 1
   INITIAL_RADIATION_ITERATIONS = 1

ELSE

   NRA = NUMBER_RADIATION_ANGLES

   ! Determine the number of polar angles (theta)

   IF (CYLINDRICAL) THEN
      NRT = NINT(SQRT(REAL(NRA)))
   ELSEIF (TWO_D) THEN
      NRT = 1
   ELSE
      NRT = 2*NINT(0.5_EB*1.17*REAL(NRA)**(1._EB/2.26))
   ENDIF

   ! Determine number of azimuthal angles (phi)

   ALLOCATE(NRP(1:NRT),STAT=IZERO)
   CALL ChkMemErr('INIT','NRP',IZERO)

   N = 0
   DO I=1,NRT
      IF (CYLINDRICAL) THEN
         NRP(I) = NINT(REAL(NRA)/(REAL(NRT)))
      ELSEIF (TWO_D) THEN
         NRP(I) = 4*NINT(0.25_EB*REAL(NRA))
      ELSE
         THETALOW = PI*REAL(I-1)/REAL(NRT)
         THETAUP  = PI*REAL(I)/REAL(NRT)
         NRP(I) = NINT(0.5_EB*REAL(NRA)*(COS(THETALOW)-COS(THETAUP)))
         NRP(I) = MAX(4,NRP(I))
         NRP(I) = 4*NINT(0.25_EB*REAL(NRP(I)))
      ENDIF
      N = N + NRP(I)
   ENDDO
   NUMBER_RADIATION_ANGLES = N

ENDIF

END SUBROUTINE READ_RADI


!> \brief Read the CLIP namelist line for user-defined mins and maxes.

SUBROUTINE READ_CLIP

REAL(EB) :: MAXIMUM_DENSITY,MINIMUM_DENSITY,MINIMUM_TEMPERATURE,MAXIMUM_TEMPERATURE
NAMELIST /CLIP/ FYI,MAXIMUM_DENSITY,MAXIMUM_TEMPERATURE,MINIMUM_DENSITY,MINIMUM_TEMPERATURE

MINIMUM_DENSITY       = -999._EB
MAXIMUM_DENSITY       = -999._EB
MINIMUM_TEMPERATURE   = -999._EB
MAXIMUM_TEMPERATURE   = -999._EB

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
CLIP_LOOP: DO
   CALL CHECKREAD('CLIP',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT CLIP_LOOP
   READ(LU_INPUT,CLIP,END=431,ERR=432,IOSTAT=IOS)
   432 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with CLIP line') ; RETURN ; ENDIF
ENDDO CLIP_LOOP
431 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (MINIMUM_TEMPERATURE>-TMPM) TMPMIN = MINIMUM_TEMPERATURE + TMPM
IF (MAXIMUM_TEMPERATURE>-TMPM) TMPMAX = MAXIMUM_TEMPERATURE + TMPM

IF (TMPMAX > 5000._EB) THEN ; CALL SHUTDOWN('MAXIMUM_TEMPERATURE cannot be greater than 4726.85 C (5000 K)') ; RETURN ; ENDIF

IF (MINIMUM_DENSITY>0._EB) THEN
   RHOMIN = MINIMUM_DENSITY
ELSE
   RHOMIN = MIN(0.1_EB*RHOA,2._EB*P_INF*MW_MIN/(R0*TMPMAX))
ENDIF

IF (MAXIMUM_DENSITY>0._EB) THEN
   RHOMAX = MAXIMUM_DENSITY
ELSE
   RHOMAX = 2._EB*P_INF*MW_MAX/(R0*MAX(TMPMIN,1._EB))
ENDIF

END SUBROUTINE READ_CLIP


!> \brief Read the RAMP namelist lines

SUBROUTINE READ_RAMP

REAL(EB) :: X,Z,T,F,TM
INTEGER  :: I,II,NN,N,NUMBER_INTERPOLATION_POINTS,N_RES_RAMP
CHARACTER(LABEL_LENGTH) :: DEVC_ID,CTRL_ID
TYPE(RAMPS_TYPE), POINTER :: RP
TYPE(RESERVED_RAMPS_TYPE), POINTER :: RRP
NAMELIST /RAMP/ CTRL_ID,DEVC_ID,F,FYI,ID,NUMBER_INTERPOLATION_POINTS,T,X,Z

IF (N_RAMP==0) RETURN

ALLOCATE(RAMPS(N_RAMP+N_CONE_RAMP),STAT=IZERO)
CALL ChkMemErr('READ','RAMPS',IZERO)

! Count the number of points in each ramp

N_RES_RAMP = 0

COUNT_RAMP_POINTS: DO N=1,N_RAMP

   RP => RAMPS(N)

   IF (RAMP_ID(N)(1:5)=='RSRVD') THEN
      N_RES_RAMP = N_RES_RAMP + 1
      RRP => RESERVED_RAMPS(N_RES_RAMP)
      RP%RESERVED = .TRUE.
      RP%NUMBER_DATA_POINTS = RRP%NUMBER_DATA_POINTS
   ELSE
      REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
      RP%NUMBER_DATA_POINTS = 0
      SEARCH_LOOP: DO
         CALL CHECKREAD('RAMP',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
         IF (IOS==1) EXIT SEARCH_LOOP
         READ(LU_INPUT,NML=RAMP,ERR=56,IOSTAT=IOS)
         IF (ID/=RAMP_ID(N)) CYCLE SEARCH_LOOP
         RP%NUMBER_DATA_POINTS = RP%NUMBER_DATA_POINTS + 1
      56 IF (IOS>0) THEN
            WRITE(MESSAGE,'(A,I5)') 'ERROR: Problem with RAMP, line number ',INPUT_FILE_LINE_NUMBER
            CALL SHUTDOWN(MESSAGE)
            RETURN
         ENDIF
      ENDDO SEARCH_LOOP
   ENDIF

   IF (RP%NUMBER_DATA_POINTS<2) THEN
      IF (RP%NUMBER_DATA_POINTS==0) WRITE(MESSAGE,'(A,A,A)') 'ERROR: RAMP ',TRIM(RAMP_ID(N)), ' not found'
      IF (RP%NUMBER_DATA_POINTS==1) WRITE(MESSAGE,'(A,A,A)') 'ERROR: RAMP ',TRIM(RAMP_ID(N)), ' has only one point'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

ENDDO COUNT_RAMP_POINTS

! Read and process the ramp functions

N_RES_RAMP = 0

READ_RAMP_LOOP: DO N=1,N_RAMP

   RP => RAMPS(N)

   RP%DEVC_ID = 'null'
   RP%CTRL_ID = 'null'
   ALLOCATE(RP%INDEPENDENT_DATA(1:RP%NUMBER_DATA_POINTS))
   ALLOCATE(RP%DEPENDENT_DATA(1:RP%NUMBER_DATA_POINTS))
   NUMBER_INTERPOLATION_POINTS=5000

   IF (RP%RESERVED) THEN

      N_RES_RAMP = N_RES_RAMP + 1
      RRP => RESERVED_RAMPS(N_RES_RAMP)
      RP%INDEPENDENT_DATA(1:RP%NUMBER_DATA_POINTS) = RRP%INDEPENDENT_DATA(1:RRP%NUMBER_DATA_POINTS)
      RP%DEPENDENT_DATA(1:RP%NUMBER_DATA_POINTS) = RRP%DEPENDENT_DATA(1:RRP%NUMBER_DATA_POINTS)
      RP%NUMBER_INTERPOLATION_POINTS = NUMBER_INTERPOLATION_POINTS

   ELSE

      REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
      NN = 0
      SEARCH_LOOP2: DO
         DEVC_ID = 'null'
         CTRL_ID = 'null'
         X       = -1.E6_EB
         Z       = -1.E6_EB
         CALL CHECKREAD('RAMP',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
         IF (IOS==1) EXIT SEARCH_LOOP2
         READ(LU_INPUT,RAMP)
         IF (ID/=RAMP_ID(N)) CYCLE SEARCH_LOOP2
         IF (RP%DEVC_ID =='null') RP%DEVC_ID = DEVC_ID
         IF (RP%CTRL_ID =='null') RP%CTRL_ID = CTRL_ID
         IF (X>-1.E5_EB) THEN
            RAMP_TYPE(N) = 'X COORDINATE'
            SPATIAL_GRAVITY_VARIATION = .TRUE.
            STRATIFICATION = .FALSE.
            T = X
         ENDIF
         IF (Z>-1.E5_EB) THEN
            RAMP_TYPE(N) = 'Z COORDINATE'
            T = Z
         ENDIF
         IF (RAMP_TYPE(N)=='TEMPERATURE') T = T + TMPM
         IF (RAMP_TYPE(N)=='TIME')        T = T_BEGIN + (T-T_BEGIN)/TIME_SHRINK_FACTOR
         NN = NN+1
         RP%INDEPENDENT_DATA(NN) = T
         IF (NN>1) THEN
            IF (T<=RP%INDEPENDENT_DATA(NN-1)) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: RAMP ',TRIM(RAMP_ID(N)), ' variable T must be monotonically increasing'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDIF
         RP%DEPENDENT_DATA(NN) = F
         RP%NUMBER_INTERPOLATION_POINTS = NUMBER_INTERPOLATION_POINTS
      ENDDO SEARCH_LOOP2

   ENDIF

   RP%T_MIN = MINVAL(RP%INDEPENDENT_DATA)
   RP%T_MAX = MAXVAL(RP%INDEPENDENT_DATA)
   RP%SPAN = RP%T_MAX - RP%T_MIN

ENDDO READ_RAMP_LOOP

! Set up interpolated ramp values in INTERPOLATED_DATA and get control or device index

DO N=1,N_RAMP
   RP => RAMPS(N)
   RP%RDT = REAL(RP%NUMBER_INTERPOLATION_POINTS,EB)/RP%SPAN
   ALLOCATE(RAMPS(N)%INTERPOLATED_DATA(0:RP%NUMBER_INTERPOLATION_POINTS+1))
   RAMPS(N)%INTERPOLATED_DATA(0) = RP%DEPENDENT_DATA(1)
   DO I=1,RP%NUMBER_INTERPOLATION_POINTS-1
      TM = RP%INDEPENDENT_DATA(1) + REAL(I,EB)/RP%RDT
      TLOOP: DO II=1,RP%NUMBER_DATA_POINTS-1
         IF (TM>=RP%INDEPENDENT_DATA(II) .AND. TM<RP%INDEPENDENT_DATA(II+1)) THEN
            RP%INTERPOLATED_DATA(I) = RP%DEPENDENT_DATA(II) +  (TM-RP%INDEPENDENT_DATA(II)) * &
                          (RP%DEPENDENT_DATA(II+1)-RP%DEPENDENT_DATA(II))/(RP%INDEPENDENT_DATA(II+1)-RP%INDEPENDENT_DATA(II))
            EXIT TLOOP
         ENDIF
      ENDDO TLOOP
   ENDDO
   RP%INTERPOLATED_DATA(RP%NUMBER_INTERPOLATION_POINTS)   = RP%DEPENDENT_DATA(RP%NUMBER_DATA_POINTS)
   RP%INTERPOLATED_DATA(RP%NUMBER_INTERPOLATION_POINTS+1) = RP%DEPENDENT_DATA(RP%NUMBER_DATA_POINTS)

   ! Get Device or Control Index

   CALL SEARCH_CONTROLLER('RAMP',RP%CTRL_ID,RP%DEVC_ID,RP%DEVC_INDEX,RP%CTRL_INDEX,N)

ENDDO

END SUBROUTINE READ_RAMP


!> \brief Read the TABLe namelist lines

SUBROUTINE READ_TABL

REAL(EB) :: TABLE_DATA(9)
INTEGER  :: NN,N,I,J
TYPE(TABLES_TYPE), POINTER :: TA=>NULL()
NAMELIST /TABL/ FYI,ID,TABLE_DATA

IF (N_TABLE==0) RETURN

ALLOCATE(TABLES(N_TABLE),STAT=IZERO)
CALL ChkMemErr('READ','TABLES',IZERO)

! Count the number of points in each table

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_TABLE_POINTS: DO N=1,N_TABLE
   TA => TABLES(N)
   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   TA%NUMBER_ROWS = 0
   SELECT CASE (TABLE_TYPE(N))
      CASE (SPRAY_PATTERN)
         TA%NUMBER_COLUMNS = 6
      CASE (PART_RADIATIVE_PROPERTY)
         TA%NUMBER_COLUMNS = 3
      CASE (TABLE_2D_TYPE)
         TA%NUMBER_COLUMNS = 3
   END SELECT
   SEARCH_LOOP: DO
      CALL CHECKREAD('TABL',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT SEARCH_LOOP
      TABLE_DATA = -999._EB
      READ(LU_INPUT,NML=TABL,ERR=56,IOSTAT=IOS)
      IF (ID/=TABLE_ID(N)) CYCLE SEARCH_LOOP
      TA%NUMBER_ROWS = TA%NUMBER_ROWS + 1
      MESSAGE='null'
      SELECT CASE(TABLE_TYPE(N))
         CASE (SPRAY_PATTERN)
            IF (TABLE_DATA(1)<0._EB .OR.           TABLE_DATA(1)>180._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad 1st lattitude'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (TABLE_DATA(2)<TABLE_DATA(1).OR. TABLE_DATA(2)>180._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad 2nd lattitude'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (TABLE_DATA(3)<-180._EB .OR.        TABLE_DATA(3)>360._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad 1st longitude'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (TABLE_DATA(4)<TABLE_DATA(3).OR. TABLE_DATA(4)>360._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad 2nd longitude'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (TABLE_DATA(5)<0._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad velocity'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (TABLE_DATA(6)<0._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad mass flow'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         CASE (PART_RADIATIVE_PROPERTY)
            IF (TABLE_DATA(1)<0._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad wave length'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (TABLE_DATA(2)<=0._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad real index'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (TABLE_DATA(3)< 0._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),' has a bad complex index'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         CASE (TABLE_2D_TYPE)
            IF (TA%NUMBER_ROWS == 1) THEN
               IF (INT(TABLE_DATA(1)) <= 0._EB) THEN
                  WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),&
                                                ' has < 1 x entries'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               IF (INT(TABLE_DATA(2)) < 0._EB) THEN
                  WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Row ',TA%NUMBER_ROWS,' of ',TRIM(TABLE_ID(N)),&
                                                ' has < 1 y entries'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
            ENDIF
      END SELECT

      56 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: Problem with TABLE '//TRIM(TABLE_ID(N)) ) ; RETURN ; ENDIF
   ENDDO SEARCH_LOOP
   IF (TA%NUMBER_ROWS<=0) THEN
      WRITE(MESSAGE,'(A,A,A)') 'ERROR: TABLE ',TRIM(TABLE_ID(N)), ' not found'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (TABLE_TYPE(N) == TABLE_2D_TYPE) THEN
      IF (TA%NUMBER_ROWS<=1) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: 2D TABLE ',TRIM(TABLE_ID(N)), ' must have at least one row of data'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF
ENDDO COUNT_TABLE_POINTS

READ_TABL_LOOP: DO N=1,N_TABLE
   TA => TABLES(N)
   ALLOCATE(TA%TABLE_DATA(TA%NUMBER_ROWS,TA%NUMBER_COLUMNS),STAT=IZERO)
   CALL ChkMemErr('READ','TA%TABLE_DATA',IZERO)
   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   NN = 0
   SEARCH_LOOP2: DO
      CALL CHECKREAD('TABL',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT SEARCH_LOOP2
      READ(LU_INPUT,TABL)
      IF (ID/=TABLE_ID(N)) CYCLE SEARCH_LOOP2
      NN = NN+1
      TA%TABLE_DATA(NN,:) = TABLE_DATA(1:TA%NUMBER_COLUMNS)
   ENDDO SEARCH_LOOP2
   TABLE_2D_IF: IF (TABLE_TYPE(N)==TABLE_2D_TYPE) THEN
      IF (TA%NUMBER_ROWS-1/=INT(TA%TABLE_DATA(1,1))*INT(TA%TABLE_DATA(1,2))) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: 2D TABLE ',TRIM(TABLE_ID(N)), ' is not rectangular'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      TA%LX = MINVAL(TA%TABLE_DATA(2:TA%NUMBER_ROWS,1),1)
      TA%UX = MAXVAL(TA%TABLE_DATA(2:TA%NUMBER_ROWS,1),1)
      TA%LY = MINVAL(TA%TABLE_DATA(2:TA%NUMBER_ROWS,2),1)
      TA%UY = MAXVAL(TA%TABLE_DATA(2:TA%NUMBER_ROWS,2),1)
      ALLOCATE(TA%X(INT(TA%TABLE_DATA(1,1))),STAT=IZERO)
      CALL ChkMemErr('READ','TA%X',IZERO)
      ALLOCATE(TA%Y(INT(TA%TABLE_DATA(1,2))),STAT=IZERO)
      CALL ChkMemErr('READ','TA%Y',IZERO)
      ALLOCATE(TA%Z(INT(TA%TABLE_DATA(1,1)),INT(TA%TABLE_DATA(1,2))),STAT=IZERO)
      CALL ChkMemErr('READ','TA%Z',IZERO)
      NN = 1
      TA%NUMBER_ROWS = INT(TA%TABLE_DATA(1,1))
      TA%NUMBER_COLUMNS = INT(TA%TABLE_DATA(1,2))
      DO I = 1, TA%NUMBER_ROWS
         DO J = 1, TA%NUMBER_COLUMNS
            NN = NN + 1
            IF (J==1) THEN
               TA%X(I)=TA%TABLE_DATA(NN,1)
            ELSE
               IF (TA%TABLE_DATA(NN,1) /= TA%X(I)) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: 2D TABLE ',TRIM(TABLE_ID(N)), ' x value must be the same for each row'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
            ENDIF
            IF (I==1) THEN
               TA%Y(J)=TA%TABLE_DATA(NN,2)
            ELSE
               IF (TA%TABLE_DATA(NN,2) /= TA%Y(J)) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: 2D TABLE ',TRIM(TABLE_ID(N)), ' y value must be the same for each column'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
            ENDIF
            TA%Z(I,J) = TA%TABLE_DATA(NN,3)
         ENDDO
      ENDDO
   ENDIF TABLE_2D_IF
ENDDO READ_TABL_LOOP

END SUBROUTINE READ_TABL


!> \brief Read the OBSTruction namelist lines

SUBROUTINE READ_OBST

USE GEOMETRY_FUNCTIONS, ONLY: BLOCK_CELL
USE COMPLEX_GEOMETRY, ONLY: INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB,INTERSECT_SPHERE_AABB,INTERSECT_OBB_AABB,ROTATION_MATRIX
USE MATH_FUNCTIONS, ONLY: GET_RAMP_INDEX
USE MISC_FUNCTIONS, ONLY: PROCESS_MESH_NEIGHBORHOOD
TYPE(OBSTRUCTION_TYPE), POINTER :: OB2=>NULL(),OBT=>NULL()
TYPE(MULTIPLIER_TYPE), POINTER :: MR=>NULL()
TYPE(OBSTRUCTION_TYPE), DIMENSION(:), ALLOCATABLE, TARGET :: TEMP_OBSTRUCTION
INTEGER :: NM,NOM,N_OBST_O,IC,N,NN,NNN,NNNN,NR,N_NEW_OBST,RGB(3),N_OBST_DIM,II,JJ,KK,EVAC_N,MULT_INDEX,SHAPE_TYPE,PYRO3D_IOR
CHARACTER(LABEL_LENGTH) :: ID,DEVC_ID,PROP_ID,SHAPE,SURF_ID,SURF_IDS(3),SURF_ID6(6),CTRL_ID,MULT_ID,MATL_ID,RAMP_Q
CHARACTER(LABEL_LENGTH) :: MESH_ID
CHARACTER(25) :: COLOR
LOGICAL :: EVACUATION_OBST,OVERLAY,IS_INTERSECT,PYRO3D_MASS_TRANSPORT
REAL(EB) :: TRANSPARENCY,XB1,XB2,XB3,XB4,XB5,XB6,BULK_DENSITY,VOL_ADJUSTED,VOL_SPECIFIED,UNDIVIDED_INPUT_AREA(3),&
            INTERNAL_HEAT_SOURCE,HEIGHT,RADIUS,XYZ(3),ORIENTATION(3),AABB(6),ROTMAT(3,3),THETA,LENGTH,WIDTH,SHAPE_AREA(3)
LOGICAL :: EMBEDDED,THICKEN,THICKEN_LOC,PERMIT_HOLE,ALLOW_VENT,EVACUATION,REMOVABLE,BNDF_FACE(-3:3),BNDF_OBST,OUTLINE,&
           HT3D,WARN_HT3D,PYRO3D_RESIDUE
NAMELIST /OBST/ ALLOW_VENT,BNDF_FACE,BNDF_OBST,BULK_DENSITY,&
                COLOR,CTRL_ID,DEVC_ID,EVACUATION,FYI,HEIGHT,HT3D,ID,INTERNAL_HEAT_SOURCE,&
                LENGTH,MATL_ID,MESH_ID,MULT_ID,&
                ORIENTATION,OUTLINE,OVERLAY,PERMIT_HOLE,PROP_ID,PYRO3D_IOR,PYRO3D_MASS_TRANSPORT,&
                RADIUS,RAMP_Q,REMOVABLE,RGB,&
                SHAPE,SURF_ID,SURF_ID6,SURF_IDS,TEXTURE_ORIGIN,THETA,THICKEN,&
                TRANSPARENCY,WIDTH,XB,XYZ

MESH_LOOP: DO NM=1,NMESHES

   M => MESHES(NM)

   IF (.NOT.PROCESS_MESH_NEIGHBORHOOD(NM)) CYCLE MESH_LOOP

   CALL POINT_TO_MESH(NM)

   ! Count OBST lines

   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   N_OBST_DIM = 0  ! Dimension of MESHES(NM)%OBSTRUCTION
   N_OBST_O   = 0  ! Number of "Original" obstructions; that is, obstructions in the input file
   COUNT_OBST_LOOP: DO
      CALL CHECKREAD('OBST',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT COUNT_OBST_LOOP
      MULT_ID = 'null'
      READ(LU_INPUT,NML=OBST,END=1,ERR=2,IOSTAT=IOS)
      CALL CHECK_XB(XB)
      MULT_INDEX = -1
      IF (MULT_ID=='null') THEN
         MULT_INDEX = 0
      ELSE
         DO N=1,N_MULT
            MR => MULTIPLIER(N)
            IF (MULT_ID==MR%ID) THEN
               MULT_INDEX = N
            ENDIF
         ENDDO
      ENDIF
      IF (MULT_INDEX==-1) THEN
         WRITE(MESSAGE,'(A,A,A,I0,A,I0)') 'ERROR: MULT line ', TRIM(MULT_ID),' not found on OBST ', N_OBST_O+1,&
                                          ', line number',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
      ENDIF
      MR => MULTIPLIER(MULT_INDEX)
      K_MULT_LOOP2: DO KK=MR%K_LOWER,MR%K_UPPER
         J_MULT_LOOP2: DO JJ=MR%J_LOWER,MR%J_UPPER
            I_MULT_LOOP2: DO II=MR%I_LOWER,MR%I_UPPER
               IF (.NOT.MR%SEQUENTIAL) THEN
                  XB1 = XB(1) + MR%DX0 + II*MR%DXB(1)
                  XB2 = XB(2) + MR%DX0 + II*MR%DXB(2)
                  XB3 = XB(3) + MR%DY0 + JJ*MR%DXB(3)
                  XB4 = XB(4) + MR%DY0 + JJ*MR%DXB(4)
                  XB5 = XB(5) + MR%DZ0 + KK*MR%DXB(5)
                  XB6 = XB(6) + MR%DZ0 + KK*MR%DXB(6)
               ELSE
                  XB1 = XB(1) + MR%DX0 + II*MR%DXB(1)
                  XB2 = XB(2) + MR%DX0 + II*MR%DXB(2)
                  XB3 = XB(3) + MR%DY0 + II*MR%DXB(3)
                  XB4 = XB(4) + MR%DY0 + II*MR%DXB(4)
                  XB5 = XB(5) + MR%DZ0 + II*MR%DXB(5)
                  XB6 = XB(6) + MR%DZ0 + II*MR%DXB(6)
               ENDIF
               N_OBST_O = N_OBST_O + 1
               IF (XB1>M%XF+M%DX(M%IBAR) .OR. XB2<M%XS-M%DX(1) .OR. &
                   XB3>M%YF+M%DY(M%JBAR) .OR. XB4<M%YS-M%DY(1) .OR. &
                   XB5>M%ZF+M%DZ(M%KBAR) .OR. XB6<M%ZS-M%DZ(1)) CYCLE I_MULT_LOOP2
               N_OBST_DIM = N_OBST_DIM + 1
            ENDDO I_MULT_LOOP2
         ENDDO J_MULT_LOOP2
      ENDDO K_MULT_LOOP2
      2 IF (IOS>0) THEN
         WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with OBST number ',N_OBST_O+1,', line number ',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
      ENDIF
   ENDDO COUNT_OBST_LOOP
   1 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

   IF (EVACUATION_ONLY(NM)) CALL DEFINE_EVACUATION_OBSTS(NM,1,0)

   ! Allocate OBSTRUCTION array

   ALLOCATE(M%OBSTRUCTION(0:N_OBST_DIM),STAT=IZERO)
   CALL ChkMemErr('READ','OBSTRUCTION',IZERO)
   OBSTRUCTION=>M%OBSTRUCTION

   N        = 0
   N_OBST   = N_OBST_O
   EVAC_N   = 1

   READ_OBST_LOOP: DO NN=1,N_OBST_O

      ID       = 'null'
      MATL_ID  = 'null'
      MULT_ID  = 'null'
      PROP_ID  = 'null'
      SURF_ID  = 'null'
      SURF_IDS = 'null'
      SURF_ID6 = 'null'
      COLOR    = 'null'
      MESH_ID  = 'null'
      RGB         = -1
      BULK_DENSITY= -1._EB
      HT3D        = .FALSE.
      INTERNAL_HEAT_SOURCE = 0._EB
      RAMP_Q      = 'null'
      TRANSPARENCY= 1._EB
      BNDF_FACE   = BNDF_DEFAULT
      BNDF_OBST   = BNDF_DEFAULT
      THICKEN     = THICKEN_OBSTRUCTIONS
      OUTLINE     = .FALSE.
      OVERLAY     = .TRUE.
      TEXTURE_ORIGIN = -999._EB
      DEVC_ID     = 'null'
      CTRL_ID     = 'null'
      PERMIT_HOLE = .TRUE.
      ALLOW_VENT  = .TRUE.
      REMOVABLE   = .TRUE.
      XB          = -9.E30_EB
      SHAPE       = 'null'
      XYZ         = 0._EB
      RADIUS      = -1._EB
      LENGTH      = -1._EB
      WIDTH       = -1._EB
      HEIGHT      = -1._EB
      ORIENTATION = (/0._EB,0._EB,1._EB/)
      THETA       = 0._EB
      PYRO3D_IOR  = 0
      PYRO3D_MASS_TRANSPORT = .FALSE.
      IF (.NOT.EVACUATION_ONLY(NM)) EVACUATION = .FALSE.
      IF (     EVACUATION_ONLY(NM)) EVACUATION = .TRUE.
      IF (     EVACUATION_ONLY(NM)) REMOVABLE  = .FALSE.
      SHAPE_TYPE  = -1
      SHAPE_AREA  = 0._EB

      ! Read the OBST line

      EVACUATION_OBST = .FALSE.
      IF (EVACUATION_ONLY(NM)) CALL DEFINE_EVACUATION_OBSTS(NM,2,EVAC_N)
      IF (.NOT. EVACUATION_OBST) THEN
         CALL CHECKREAD('OBST',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
         IF (IOS==1) EXIT READ_OBST_LOOP
         READ(LU_INPUT,OBST,END=35)
      ENDIF

      ! Reorder OBST coordinates if necessary

      CALL CHECK_XB(XB)

      ! No device and controls for evacuation obstructions

      IF (EVACUATION_ONLY(NM)) THEN
         DEVC_ID = 'null'
         CTRL_ID = 'null'
         PROP_ID = 'null'
      ENDIF

      ! Special shapes

      IF (TRIM(SHAPE)/='null') THEN
         SELECT CASE(TRIM(SHAPE))
            CASE('SPHERE')
               SHAPE_TYPE = OBST_SPHERE_TYPE
               SHAPE_AREA(1) = 4._EB*PI*RADIUS**2
            CASE('CYLINDER')
               SHAPE_TYPE = OBST_CYLINDER_TYPE
               SHAPE_AREA(1) = PI*RADIUS**2
               SHAPE_AREA(2) = 2._EB*PI*RADIUS*HEIGHT
               SHAPE_AREA(3) = PI*RADIUS**2
               CALL ROTATION_MATRIX(ROTMAT,ORIENTATION,THETA)
            CASE('CONE')
               SHAPE_TYPE = OBST_CONE_TYPE
               SHAPE_AREA(1) = PI*RADIUS*( RADIUS + SQRT(HEIGHT**2 + RADIUS**2) ) - PI*RADIUS**2
               SHAPE_AREA(2) = PI*RADIUS**2
               CALL ROTATION_MATRIX(ROTMAT,ORIENTATION,THETA)
            CASE('BOX')
               SHAPE_TYPE = OBST_BOX_TYPE
               SHAPE_AREA(1) = LENGTH*WIDTH
               SHAPE_AREA(2) = WIDTH*HEIGHT
               SHAPE_AREA(3) = HEIGHT*LENGTH
               CALL ROTATION_MATRIX(ROTMAT,ORIENTATION,THETA)
         END SELECT
         IF ((SHAPE_TYPE==OBST_SPHERE_TYPE .OR. SHAPE_TYPE==OBST_CYLINDER_TYPE .OR. SHAPE_TYPE==OBST_CONE_TYPE) &
            .AND. RADIUS<0._EB) THEN
            WRITE(MESSAGE,'(A,I0,A)')  'ERROR: OBST ',NN,' SHAPE requires RADIUS'
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         ENDIF
         IF ((SHAPE_TYPE==OBST_CYLINDER_TYPE .OR. SHAPE_TYPE==OBST_CONE_TYPE) .AND. HEIGHT<0._EB) THEN
            WRITE(MESSAGE,'(A,I0,A)')  'ERROR: OBST ',NN,' SHAPE requires HEIGHT'
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         ENDIF
         IF (SHAPE_TYPE==OBST_BOX_TYPE .AND. (LENGTH<0._EB .OR. WIDTH<0._EB .OR. HEIGHT<0._EB)) THEN
            WRITE(MESSAGE,'(A,I0,A)')  'ERROR: OBST ',NN,' BOX SHAPE requires LENGTH, WIDTH, HEIGHT'
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         ENDIF
         IF (ORIENTATION(1)==0._EB .AND. &
             ORIENTATION(2)==0._EB .AND. &
             ORIENTATION(3)==1._EB .AND. &
             NMESHES==1                  ) THEN
            OBST_SHAPE_AREA_ADJUST = .TRUE.
         ELSE
            OBST_SHAPE_AREA_ADJUST = .FALSE.
            WRITE (LU_ERR,'(A)') 'WARNING: AREA_ADJUST not applied to reoriented SHAPE or SHAPE that spans multiple MESHES.'
         ENDIF
      ENDIF

      ! Loop over all possible multiples of the OBST

      MR => MULTIPLIER(0)
      DO NNN=1,N_MULT
         IF (MULT_ID==MULTIPLIER(NNN)%ID) THEN
            MULT_INDEX=NNN
            MR => MULTIPLIER(NNN)
         ENDIF
      ENDDO

      K_MULT_LOOP: DO KK=MR%K_LOWER,MR%K_UPPER
         J_MULT_LOOP: DO JJ=MR%J_LOWER,MR%J_UPPER
            I_MULT_LOOP: DO II=MR%I_LOWER,MR%I_UPPER

               IF (MR%SKIP(II,JJ,KK)) CYCLE I_MULT_LOOP

               IF (.NOT.MR%SEQUENTIAL) THEN
                  XB1 = XB(1) + MR%DX0 + II*MR%DXB(1)
                  XB2 = XB(2) + MR%DX0 + II*MR%DXB(2)
                  XB3 = XB(3) + MR%DY0 + JJ*MR%DXB(3)
                  XB4 = XB(4) + MR%DY0 + JJ*MR%DXB(4)
                  XB5 = XB(5) + MR%DZ0 + KK*MR%DXB(5)
                  XB6 = XB(6) + MR%DZ0 + KK*MR%DXB(6)
               ELSE
                  XB1 = XB(1) + MR%DX0 + II*MR%DXB(1)
                  XB2 = XB(2) + MR%DX0 + II*MR%DXB(2)
                  XB3 = XB(3) + MR%DY0 + II*MR%DXB(3)
                  XB4 = XB(4) + MR%DY0 + II*MR%DXB(4)
                  XB5 = XB(5) + MR%DZ0 + II*MR%DXB(5)
                  XB6 = XB(6) + MR%DZ0 + II*MR%DXB(6)
               ENDIF

               ! Increase the OBST counter

               N = N + 1

               ! Evacuation criteria

               EVAC_N = EVAC_N + 1
               IF (MESH_ID/=MESH_NAME(NM) .AND. MESH_ID/='null') THEN
                  N = N-1
                  N_OBST = N_OBST-1
                  CYCLE I_MULT_LOOP
               ENDIF

               IF ((.NOT.EVACUATION .AND. EVACUATION_ONLY(NM)) .OR. (EVACUATION .AND. .NOT.EVACUATION_ONLY(NM))) THEN
                  N = N-1
                  N_OBST = N_OBST-1
                  CYCLE I_MULT_LOOP
               ENDIF

               ! Look for obstructions that are within a half grid cell of the current mesh. If the obstruction is thin and has the
               ! THICKEN attribute, look for it within an entire grid cell.

               THICKEN_LOC = THICKEN

               IF ( (XB2>=XS-0.5_EB*DX(0)   .AND. XB2<XS) .OR. (THICKEN .AND. 0.5_EB*(XB1+XB2)>=XS-DX(0)    .AND. XB2<XS) ) THEN
                  XB1 = XS
                  XB2 = XS
                  THICKEN_LOC = .FALSE.
               ENDIF
               IF ( (XB1<XF+0.5_EB*DX(IBP1) .AND. XB1>XF) .OR. (THICKEN .AND. 0.5_EB*(XB1+XB2)< XF+DX(IBP1) .AND. XB1>XF) ) THEN
                  XB1 = XF
                  XB2 = XF
                  THICKEN_LOC = .FALSE.
               ENDIF
               IF ( (XB4>=YS-0.5_EB*DY(0)   .AND. XB4<YS) .OR. (THICKEN .AND. 0.5_EB*(XB3+XB4)>=YS-DY(0)    .AND. XB4<YS) ) THEN
                  XB3 = YS
                  XB4 = YS
                  THICKEN_LOC = .FALSE.
               ENDIF
               IF ( (XB3<YF+0.5_EB*DY(JBP1) .AND. XB3>YF) .OR. (THICKEN .AND. 0.5_EB*(XB3+XB4)< YF+DY(JBP1) .AND. XB3>YF) ) THEN
                  XB3 = YF
                  XB4 = YF
                  THICKEN_LOC = .FALSE.
               ENDIF
               IF ( ((XB6>=ZS-0.5_EB*DZ(0)   .AND. XB6<ZS) .OR. (THICKEN .AND. 0.5_EB*(XB5+XB6)>=ZS-DZ(0)    .AND. XB6<ZS)) .AND. &
                  .NOT.EVACUATION_ONLY(NM)) THEN
                  XB5 = ZS
                  XB6 = ZS
                  THICKEN_LOC = .FALSE.
               ENDIF
               IF ( ((XB5<ZF+0.5_EB*DZ(KBP1) .AND. XB5>ZF) .OR. (THICKEN .AND. 0.5_EB*(XB5+XB6)< ZF+DZ(KBP1) .AND. XB5>ZF)) .AND. &
                  .NOT.EVACUATION_ONLY(NM)) THEN
                  XB5 = ZF
                  XB6 = ZF
                  THICKEN_LOC = .FALSE.
               ENDIF

               ! Save the original, undivided obstruction face areas.

               UNDIVIDED_INPUT_AREA(1) = (XB4-XB3)*(XB6-XB5)
               UNDIVIDED_INPUT_AREA(2) = (XB2-XB1)*(XB6-XB5)
               UNDIVIDED_INPUT_AREA(3) = (XB2-XB1)*(XB4-XB3)

               ! Throw out obstructions that are not within computational domain

               XB1 = MAX(XB1,XS)
               XB2 = MIN(XB2,XF)
               XB3 = MAX(XB3,YS)
               XB4 = MIN(XB4,YF)
               XB5 = MAX(XB5,ZS)
               XB6 = MIN(XB6,ZF)
               IF (XB1>XF .OR. XB2<XS .OR. XB3>YF .OR. XB4<YS .OR. XB5>ZF .OR. XB6<ZS) THEN
                  N = N-1
                  N_OBST = N_OBST-1
                  CYCLE I_MULT_LOOP
               ENDIF

               ! Begin processing of OBSTruction

               OB=>OBSTRUCTION(N)

               OB%UNDIVIDED_INPUT_AREA(1) = UNDIVIDED_INPUT_AREA(1)
               OB%UNDIVIDED_INPUT_AREA(2) = UNDIVIDED_INPUT_AREA(2)
               OB%UNDIVIDED_INPUT_AREA(3) = UNDIVIDED_INPUT_AREA(3)

               OB%X1 = XB1
               OB%X2 = XB2
               OB%Y1 = XB3
               OB%Y2 = XB4
               OB%Z1 = XB5
               OB%Z2 = XB6

               ! Thicken evacuation mesh obstructions in the z direction

               IF (EVACUATION_ONLY(NM) .AND. EVACUATION) THEN
                  OB%Z1 = ZS
                  OB%Z2 = ZF
                  XB5   = ZS
                  XB6   = ZF
               ENDIF

               ! Determine the indices of the obstruction according to cell edges, not centers.

               OB%I1 = NINT( GINV(XB1-XS,1,NM)*RDXI   )
               OB%I2 = NINT( GINV(XB2-XS,1,NM)*RDXI   )
               OB%J1 = NINT( GINV(XB3-YS,2,NM)*RDETA  )
               OB%J2 = NINT( GINV(XB4-YS,2,NM)*RDETA  )
               OB%K1 = NINT( GINV(XB5-ZS,3,NM)*RDZETA )
               OB%K2 = NINT( GINV(XB6-ZS,3,NM)*RDZETA )

               ! If desired, thicken small obstructions

               IF (THICKEN_LOC) THEN
                  IF(OB%I1==OB%I2) THEN
                     OB%I1 = INT(GINV(.5_EB*(XB1+XB2)-XS,1,NM)*RDXI)
                     OB%I2 = MIN(OB%I1+1,IBAR)
                  ENDIF
                  IF (OB%J1==OB%J2) THEN
                     OB%J1 = INT(GINV(.5_EB*(XB3+XB4)-YS,2,NM)*RDETA)
                     OB%J2 = MIN(OB%J1+1,JBAR)
                  ENDIF
                  IF (OB%K1==OB%K2) THEN
                     OB%K1 = INT(GINV(.5_EB*(XB5+XB6)-ZS,3,NM)*RDZETA)
                     OB%K2 = MIN(OB%K1+1,KBAR)
                  ENDIF
               ELSE
                  !Don't allow thickening if an OBST straddles the midpoint and is small compared to grid cell
                  IF (GINV(XB2-XS,1,NM)-GINV(XB1-XS,1,NM)<0.25_EB/RDXI .AND. OB%I1 /= OB%I2) THEN
                     IF(GINV(XB1-XS,1,NM)-REAL(OB%I1,EB) < REAL(OB%I2,EB) - GINV(XB2-XS,1,NM)) THEN
                        OB%I2=OB%I1
                     ELSE
                        OB%I1=OB%I2
                     ENDIF
                  ENDIF
                  IF (GINV(XB4-YS,2,NM)-GINV(XB3-YS,2,NM)<0.25_EB/RDETA .AND. OB%J1 /= OB%J2) THEN
                     IF(GINV(XB3-XS,2,NM)-REAL(OB%J1,EB) < REAL(OB%J2,EB) - GINV(XB4-YS,2,NM)) THEN
                        OB%J2=OB%J1
                     ELSE
                        OB%J1=OB%J2
                     ENDIF
                  ENDIF
                  IF (GINV(XB6-ZS,3,NM)-GINV(XB5-ZS,3,NM)<0.25_EB/RDZETA .AND. OB%K1 /= OB%K2) THEN
                     IF(GINV(XB5-ZS,3,NM)-REAL(OB%I1,EB) < REAL(OB%I2,EB) - GINV(XB6-ZS,3,NM)) THEN
                        OB%K2=OB%K1
                     ELSE
                        OB%K1=OB%K2
                     ENDIF
                  ENDIF
               ENDIF

               ! Throw out obstructions that are too small

               IF ((OB%I1==OB%I2.AND.OB%J1==OB%J2) .OR. (OB%I1==OB%I2.AND.OB%K1==OB%K2) .OR. (OB%J1==OB%J2.AND.OB%K1==OB%K2)) THEN
                  N = N-1
                  N_OBST= N_OBST-1
                  CYCLE I_MULT_LOOP
               ENDIF

               ! Throw out obstructions that are outside shape hull

               IF (SHAPE_TYPE>0) THEN
                  !AABB = (/XB1,XB2,XB3,XB4,XB5,XB6/)
                  AABB = (/X(OB%I1),X(OB%I2),Y(OB%J1),Y(OB%J2),Z(OB%K1),Z(OB%K2)/) ! possibly THICKENed OBST
                  SELECT CASE (SHAPE_TYPE)
                     CASE (OBST_SPHERE_TYPE);   IS_INTERSECT = INTERSECT_SPHERE_AABB(XYZ,RADIUS,AABB)
                     CASE (OBST_CYLINDER_TYPE); IS_INTERSECT = INTERSECT_CYLINDER_AABB(XYZ,HEIGHT,RADIUS,ROTMAT,AABB)
                     CASE (OBST_CONE_TYPE);     IS_INTERSECT = INTERSECT_CONE_AABB(XYZ,HEIGHT,RADIUS,ROTMAT,AABB)
                     CASE (OBST_BOX_TYPE);      IS_INTERSECT = INTERSECT_OBB_AABB(XYZ,LENGTH,WIDTH,HEIGHT,ROTMAT,AABB)
                  END SELECT
                  IF (.NOT.IS_INTERSECT) THEN
                     N = N-1
                     N_OBST = N_OBST-1
                     CYCLE I_MULT_LOOP
                  ENDIF
                  ! Snap OBST to mesh, special AREA_ADJUST required for SHAPE (see init.90)
                  OB%X1 = X(OB%I1)
                  OB%X2 = X(OB%I2)
                  OB%Y1 = Y(OB%J1)
                  OB%Y2 = Y(OB%J2)
                  OB%Z1 = Z(OB%K1)
                  OB%Z2 = Z(OB%K2)
                  ! Store SHAPE_AREA for area adjustment
                  OB%SHAPE_TYPE = SHAPE_TYPE
                  OB%SHAPE_AREA = SHAPE_AREA
                  OB%MULT_INDEX = MULT_INDEX
               ENDIF

               ! Check to see if obstruction is completely embedded in another

               EMBEDDED = .FALSE.
               EMBED_LOOP: DO NNN=1,N-1
                  OB2=>OBSTRUCTION(NNN)
                  IF (OB%I1>OB2%I1 .AND. OB%I2<OB2%I2 .AND. &
                      OB%J1>OB2%J1 .AND. OB%J2<OB2%J2 .AND. &
                      OB%K1>OB2%K1 .AND. OB%K2<OB2%K2) THEN
                     EMBEDDED = .TRUE.
                     EXIT EMBED_LOOP
                  ENDIF
               ENDDO EMBED_LOOP

               IF (EMBEDDED .AND. DEVC_ID=='null' .AND. REMOVABLE .AND. CTRL_ID=='null' ) THEN
                  N = N-1
                  N_OBST= N_OBST-1
                  CYCLE I_MULT_LOOP
               ENDIF

               ! Check if the SURF IDs exist

               IF (EVACUATION_ONLY(NM)) SURF_ID=EVAC_SURF_DEFAULT

               IF (SURF_ID/='null') CALL CHECK_SURF_NAME(SURF_ID,EX)
               IF (.NOT.EX) THEN
                  WRITE(MESSAGE,'(A,A,A)')  'ERROR: SURF_ID ',TRIM(SURF_ID),' does not exist'
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF

               DO NNNN=1,3
                  IF (EVACUATION_ONLY(NM)) SURF_IDS(NNNN)=EVAC_SURF_DEFAULT
                  IF (SURF_IDS(NNNN)/='null') CALL CHECK_SURF_NAME(SURF_IDS(NNNN),EX)
                  IF (.NOT.EX) THEN
                     WRITE(MESSAGE,'(A,A,A)')  'ERROR: SURF_ID ',TRIM(SURF_IDS(NNNN)),' does not exist'
                     CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                  ENDIF
               ENDDO

               DO NNNN=1,6
                  IF (EVACUATION_ONLY(NM)) SURF_ID6(NNNN)=EVAC_SURF_DEFAULT
                  IF (SURF_ID6(NNNN)/='null') CALL CHECK_SURF_NAME(SURF_ID6(NNNN),EX)
                  IF (.NOT.EX) THEN
                     WRITE(MESSAGE,'(A,A,A)')  'ERROR: SURF_ID ',TRIM(SURF_ID6(NNNN)),' does not exist'
                     CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                  ENDIF
               ENDDO

               ! Save boundary condition info for obstacles

               OB%SURF_INDEX(:) = DEFAULT_SURF_INDEX

               NNNN = 0
               DO NNN=0,N_SURF
                  IF (SURF_ID    ==SURFACE(NNN)%ID) OB%SURF_INDEX(:)    = NNN
                  IF (SURF_IDS(1)==SURFACE(NNN)%ID) OB%SURF_INDEX(3)    = NNN
                  IF (SURF_IDS(2)==SURFACE(NNN)%ID) OB%SURF_INDEX(-2:2) = NNN
                  IF (SURF_IDS(3)==SURFACE(NNN)%ID) OB%SURF_INDEX(-3)   = NNN
                  IF (SURF_ID6(1)==SURFACE(NNN)%ID) OB%SURF_INDEX(-1)   = NNN
                  IF (SURF_ID6(2)==SURFACE(NNN)%ID) OB%SURF_INDEX( 1)   = NNN
                  IF (SURF_ID6(3)==SURFACE(NNN)%ID) OB%SURF_INDEX(-2)   = NNN
                  IF (SURF_ID6(4)==SURFACE(NNN)%ID) OB%SURF_INDEX( 2)   = NNN
                  IF (SURF_ID6(5)==SURFACE(NNN)%ID) OB%SURF_INDEX(-3)   = NNN
                  IF (SURF_ID6(6)==SURFACE(NNN)%ID) OB%SURF_INDEX( 3)   = NNN
                  IF (TRIM(SURFACE(NNN)%ID)==TRIM(EVAC_SURF_DEFAULT)) NNNN = NNN
               ENDDO

               ! Fire + evacuation calculation: draw obsts as outlines by default

               IF (.NOT.OUTLINE .AND. EVACUATION_ONLY(NM) .AND. .NOT.ALL(EVACUATION_ONLY)) THEN
                  IF (SURFACE(NNNN)%TRANSPARENCY < 0.99999_EB .AND. .NOT.OUTLINE) THEN
                     OUTLINE = .FALSE.
                  ELSE
                     OUTLINE = .TRUE.
                  ENDIF
               ENDIF

               ! Determine if the OBST is CONSUMABLE

               FACE_LOOP: DO NNN=-3,3
                  IF (NNN==0) CYCLE FACE_LOOP
                  IF (SURFACE(OB%SURF_INDEX(NNN))%BURN_AWAY) OB%CONSUMABLE = .TRUE.
               ENDDO FACE_LOOP

               ! Calculate the increase or decrease in the obstruction volume over the user-specified

               VOL_SPECIFIED = (OB%X2-OB%X1)*(OB%Y2-OB%Y1)*(OB%Z2-OB%Z1)
               VOL_ADJUSTED  = (X(OB%I2)-X(OB%I1))*(Y(OB%J2)-Y(OB%J1))*(Z(OB%K2)-Z(OB%K1))
               IF (VOL_SPECIFIED>0._EB .AND. .NOT.EVACUATION_ONLY(NM)) THEN
                  OB%VOLUME_ADJUST = VOL_ADJUSTED/VOL_SPECIFIED
               ELSE
                  OB%VOLUME_ADJUST = 0._EB
               ENDIF

               ! Creation and removal logic

               OB%ID      = ID
               OB%DEVC_ID = DEVC_ID
               OB%CTRL_ID = CTRL_ID
               OB%HIDDEN = .FALSE.

               ! Property ID

               OB%PROP_ID = PROP_ID

               CALL SEARCH_CONTROLLER('OBST',CTRL_ID,DEVC_ID,OB%DEVC_INDEX,OB%CTRL_INDEX,N)
               IF (DEVC_ID /='null' .OR. CTRL_ID /='null') OB%REMOVABLE = .TRUE.

               IF (OB%CONSUMABLE .AND. .NOT.EVACUATION_ONLY(NM)) OB%REMOVABLE = .TRUE.

               ! Choose obstruction color index

               SELECT CASE (COLOR)
                  CASE ('INVISIBLE')
                     OB%COLOR_INDICATOR = -3
                     RGB(1) = 255
                     RGB(2) = 204
                     RGB(3) = 102
                     TRANSPARENCY = 0._EB
                  CASE ('null')
                     IF (ANY (RGB<0)) THEN
                        OB%COLOR_INDICATOR = -1
                     ELSE
                        OB%COLOR_INDICATOR = -3
                     ENDIF
                  CASE DEFAULT
                     CALL COLOR2RGB(RGB,COLOR)
                     OB%COLOR_INDICATOR = -3
               END SELECT
               OB%RGB  = RGB
               OB%TRANSPARENCY = TRANSPARENCY

               ! Miscellaneous assignments

               OB%TEXTURE(:) = TEXTURE_ORIGIN(:)  ! Origin of texture map
               OB%ORDINAL = NN  ! Order of OBST in original input file
               OB%PERMIT_HOLE = PERMIT_HOLE
               OB%ALLOW_VENT  = ALLOW_VENT
               OB%OVERLAY     = OVERLAY

               ! Only allow the use of BULK_DENSITY if the obstruction has a non-zero volume

               IF (EVACUATION_ONLY(NM)) BULK_DENSITY = -1._EB
               OB%BULK_DENSITY = BULK_DENSITY
               IF (VOL_ADJUSTED<TWO_EPSILON_EB .AND. OB%BULK_DENSITY>0._EB) OB%BULK_DENSITY = -1._EB

               ! Error traps and warnings for HT3D

               IF (.NOT.HT3D .AND. ABS(INTERNAL_HEAT_SOURCE)>TWO_EPSILON_EB) THEN
                  WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Problem with OBST number ',NN,', INTERNAL_HEAT_SOURCE requires HT3D=T.'
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF

               ! No HT3D for EVAC or zero volume OBST

               IF (EVACUATION_ONLY(NM)) HT3D=.FALSE.

               ! 3D Solid heat transfer and pyrolysis

               HT3D_IF: IF (HT3D) THEN

                  OB%HT3D = HT3D
                  SOLID_HT3D = .TRUE. ! global parameter

                  IF (VOL_ADJUSTED<TWO_EPSILON_EB) THEN
                     ! test if OB is on boundary
                     WARN_HT3D = .TRUE.
                     IF (OB%I1==OB%I2 .AND. (OB%I1==0 .OR. OB%I2==IBAR)) WARN_HT3D = .FALSE.
                     IF (OB%J1==OB%J2 .AND. (OB%J1==0 .OR. OB%J2==IBAR)) WARN_HT3D = .FALSE.
                     IF (OB%K1==OB%K2 .AND. (OB%K1==0 .OR. OB%K2==IBAR)) WARN_HT3D = .FALSE.
                     IF (WARN_HT3D) THEN
                        WRITE(LU_ERR,'(A,I0,A,I0,A)') 'WARNING: OBST ',N,' on MESH ',NM,&
                           ' has zero volume, consider THICKEN=T or move mesh boundary, HT3D set to F.'
                        OB%HT3D=.FALSE. ! later add capability for 2D lateral ht on thin obst
                     ENDIF
                  ENDIF

                  ! Set MATL_ID for HT3D

                  OB%MATL_ID = MATL_ID
                  DO NNN=1,N_MATL
                     ML=>MATERIAL(NNN)
                     IF (TRIM(OB%MATL_ID)==TRIM(ML%ID)) THEN
                        OB%MATL_INDEX=NNN
                        IF (ABS(OB%VOLUME_ADJUST)>TWO_EPSILON_EB) OB%BULK_DENSITY=ML%RHO_S
                        EXIT
                     ENDIF
                  ENDDO

                  OBST_MATL_IF: IF (OB%MATL_INDEX<0) THEN

                     ! If no MATL_ID is specified on OBST, look for a SURF_ID with a MATL_ID (used for 3D pyrolysis)

                     DO NNN=-3,3
                        IF ( SURFACE(OB%SURF_INDEX(NNN))%N_MATL>0 ) THEN
                           OB%MATL_SURF_INDEX = OB%SURF_INDEX(NNN)
                           EXIT
                        ENDIF
                     ENDDO

                     ! MATL_ID not found on OBST or SURF lines

                     IF (OB%MATL_SURF_INDEX==-1) THEN
                        WRITE(MESSAGE,'(A,I0,A)') "ERROR: Problem with OBST number ",NN,", HT3D requires a MATL_ID."
                        CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                     ENDIF

                     SF => SURFACE(OB%MATL_SURF_INDEX)

                     ! SURF associated with HT3D may have only 1 layer

                     IF (SF%N_LAYERS/=1) THEN
                        WRITE(MESSAGE,'(A,I0,A,A,A)') "ERROR: Problem with OBST number ",NN,", SURF_ID='", &
                           TRIM(SF%ID),"', N_LAYERS must be 1 for HT3D SURF."
                        CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                     ENDIF

                     ! Emissivities for SURF with MATL_IDs set in READ_SURF

                     ! Allocate and initialize MATL densities in OBST for 3D pyrolysis

                     ALLOCATE(OB%RHO(OB%I1+1:OB%I2,OB%J1+1:OB%J2,OB%K1+1:OB%K2,SF%N_MATL),STAT=IZERO)
                     CALL ChkMemErr('READ_OBST','RHO',IZERO)
                     PYRO3D_RESIDUE=.FALSE.
                     DO NNN=1,SF%N_MATL
                        ML=>MATERIAL(SF%MATL_INDEX(NNN))
                        IF (ML%N_REACTIONS>0) THEN
                           OB%PYRO3D=.TRUE.
                           OB%PYRO3D_IOR=PYRO3D_IOR      ! tell PYRO3D which direction to send pyrolyzate
                           OB%MT3D=PYRO3D_MASS_TRANSPORT ! supercedes PYRO3D_IOR
                           DO NR=1,ML%N_REACTIONS
                              IF (ABS(SUM(ML%NU_RESIDUE(:,NR)))>TWO_EPSILON_EB) PYRO3D_RESIDUE=.TRUE.
                           ENDDO
                        ENDIF
                        OB%RHO(:,:,:,NNN) = ML%RHO_S ! TEMPORARY -- must be reinitialized after PROC_WALL is called
                     ENDDO
                     IF (OB%PYRO3D .AND. .NOT.PYRO3D_RESIDUE .AND. .NOT.OB%CONSUMABLE) THEN
                        WRITE(MESSAGE,'(A,A,A)') &
                           'ERROR: MATLs associated to SURF ',TRIM(SF%ID), &
                           ', PYRO3D requires residue (NU_MATL) or BURN_AWAY for the corresponding materials'
                        CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                     ENDIF

                  ELSE OBST_MATL_IF

                     ! Don't allow both OBST and SURF with MATL_IDs

                     DO NNN=-3,3
                        IF ( SURFACE(OB%SURF_INDEX(NNN))%N_MATL>0 ) THEN
                           WRITE(MESSAGE,'(A,I0,A,A,A)') "ERROR: Problem with OBST number ",NN,", SURF_ID='", &
                              TRIM(SURFACE(OB%SURF_INDEX(NNN))%ID),"', cannot specify MATL_ID on both OBST and SURF."
                           CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                        ENDIF
                     ENDDO

                     ! Set SURF emissivities to MATL emissivity

                     DO NNN=-3,3
                        SURFACE(OB%SURF_INDEX(NNN))%EMISSIVITY = MATERIAL(OB%MATL_INDEX)%EMISSIVITY
                     ENDDO

                  ENDIF OBST_MATL_IF

                  ! Volumetric heat source term

                  OB%INTERNAL_HEAT_SOURCE = INTERNAL_HEAT_SOURCE * 1000._EB ! W/m^3
                  IF (RAMP_Q/='null') CALL GET_RAMP_INDEX(RAMP_Q,'TIME',OB%RAMP_Q_INDEX)

               ENDIF HT3D_IF

               ! Make obstruction invisible if it's within a finer mesh

               DO NOM=1,NM-1
                  IF (EVACUATION_ONLY(NOM)) CYCLE
                  IF (EVACUATION_ONLY(NM)) CYCLE
                  IF (XB1>MESHES(NOM)%XS .AND. XB2<MESHES(NOM)%XF .AND. &
                      XB3>MESHES(NOM)%YS .AND. XB4<MESHES(NOM)%YF .AND. &
                      XB5>MESHES(NOM)%ZS .AND. XB6<MESHES(NOM)%ZF) OB%COLOR_INDICATOR=-2
               ENDDO

               ! Prevent drawing of boundary info if desired

               IF (BNDF_DEFAULT) THEN
                  OB%SHOW_BNDF(:) = BNDF_FACE(:)
                  IF (.NOT.BNDF_OBST) OB%SHOW_BNDF(:) = .FALSE.
               ELSE
                  OB%SHOW_BNDF(:) = BNDF_FACE(:)
                  IF (BNDF_OBST) OB%SHOW_BNDF(:) = .TRUE.
               ENDIF
               IF (EVACUATION_ONLY(NM)) OB%SHOW_BNDF(:) = .FALSE.

               ! In Smokeview, draw the outline of the obstruction

               IF (OUTLINE) OB%TYPE_INDICATOR = 2

            ENDDO I_MULT_LOOP
         ENDDO J_MULT_LOOP
      ENDDO K_MULT_LOOP

   ENDDO READ_OBST_LOOP
35 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

ENDDO MESH_LOOP

! Read HOLEs and cut out blocks

CALL READ_HOLE

! Look for OBSTructions that are meant to BURN_AWAY and break them up into single cell blocks

MESH_LOOP_2: DO NM=1,NMESHES

   M => MESHES(NM)

   IF (.NOT.PROCESS_MESH_NEIGHBORHOOD(NM)) CYCLE MESH_LOOP_2

   CALL POINT_TO_MESH(NM)

   N_OBST_O = N_OBST
   DO N=1,N_OBST_O
      OB => OBSTRUCTION(N)
      IF (OB%CONSUMABLE .AND..NOT.EVACUATION_ONLY(NM)) THEN

         N_NEW_OBST = MAX(1,OB%I2-OB%I1)*MAX(1,OB%J2-OB%J1)*MAX(1,OB%K2-OB%K1)
         IF (N_NEW_OBST > 1) THEN

            ! Create a temporary array of obstructions with the same properties as the one being replaced, except coordinates

            ALLOCATE(TEMP_OBSTRUCTION(N_NEW_OBST))
            DO NN=1,N_NEW_OBST
               TEMP_OBSTRUCTION(NN) = OBSTRUCTION(N)
            ENDDO
            NN = 0
            DO K=OB%K1,MAX(OB%K1,OB%K2-1)
               DO J=OB%J1,MAX(OB%J1,OB%J2-1)
                  DO I=OB%I1,MAX(OB%I1,OB%I2-1)
                     NN = NN + 1
                     OBT=>TEMP_OBSTRUCTION(NN)
                     OBT%I1 = I
                     OBT%I2 = MIN(I+1,OB%I2)
                     OBT%J1 = J
                     OBT%J2 = MIN(J+1,OB%J2)
                     OBT%K1 = K
                     OBT%K2 = MIN(K+1,OB%K2)
                     OBT%X1 = M%X(OBT%I1)
                     OBT%X2 = M%X(OBT%I2)
                     OBT%Y1 = M%Y(OBT%J1)
                     OBT%Y2 = M%Y(OBT%J2)
                     OBT%Z1 = M%Z(OBT%K1)
                     OBT%Z2 = M%Z(OBT%K2)
                  ENDDO
                ENDDO
            ENDDO

            CALL RE_ALLOCATE_OBST(NM,N_OBST,N_NEW_OBST-1)
            OBSTRUCTION=>M%OBSTRUCTION
            OBSTRUCTION(N) = TEMP_OBSTRUCTION(1)
            OBSTRUCTION(N_OBST+1:N_OBST+N_NEW_OBST-1) = TEMP_OBSTRUCTION(2:N_NEW_OBST)
            N_OBST = N_OBST + N_NEW_OBST-1
            DEALLOCATE(TEMP_OBSTRUCTION)

         ENDIF
      ENDIF
   ENDDO

ENDDO MESH_LOOP_2

! Allocate the number of cells for each mesh that are SOLID or border a boundary

ALLOCATE(CELL_COUNT(NMESHES)) ; CELL_COUNT = 0

! Go through all meshes, recording which cells are solid

MESH_LOOP_3: DO NM=1,NMESHES

   M => MESHES(NM)

   IF (.NOT.PROCESS_MESH_NEIGHBORHOOD(NM)) CYCLE MESH_LOOP_3

   CALL POINT_TO_MESH(NM)

   ! Compute areas of obstruction faces, both actual (AB0) and FDS approximated (AB)

   DO N=1,N_OBST
      OB=>OBSTRUCTION(N)
      OB%INPUT_AREA(1) = (OB%Y2-OB%Y1)*(OB%Z2-OB%Z1)
      OB%INPUT_AREA(2) = (OB%X2-OB%X1)*(OB%Z2-OB%Z1)
      OB%INPUT_AREA(3) = (OB%X2-OB%X1)*(OB%Y2-OB%Y1)
      OB%FDS_AREA(1)   = (Y(OB%J2)-Y(OB%J1))*(Z(OB%K2)-Z(OB%K1))
      OB%FDS_AREA(2)   = (X(OB%I2)-X(OB%I1))*(Z(OB%K2)-Z(OB%K1))
      OB%FDS_AREA(3)   = (X(OB%I2)-X(OB%I1))*(Y(OB%J2)-Y(OB%J1))
   ENDDO

   ! Create main blockage index array (ICA)

   ALLOCATE(M%CELL_INDEX(0:IBP1,0:JBP1,0:KBP1),STAT=IZERO)
   CALL ChkMemErr('READ','CELL_INDEX',IZERO) ; CELL_INDEX=>M%CELL_INDEX ; CELL_INDEX = 0

   DO K=0,KBP1
      IF (EVACUATION_ONLY(NM) .AND. .NOT.(K==1)) CYCLE
      DO J=0,JBP1
         DO I=0,1
            IF (CELL_INDEX(I,J,K)==0) THEN
               CELL_COUNT(NM) = CELL_COUNT(NM) + 1
               CELL_INDEX(I,J,K) = CELL_COUNT(NM)
            ENDIF
         ENDDO
         DO I=IBAR,IBP1
            IF (CELL_INDEX(I,J,K)==0) THEN
               CELL_COUNT(NM) = CELL_COUNT(NM) + 1
               CELL_INDEX(I,J,K) = CELL_COUNT(NM)
            ENDIF
         ENDDO
      ENDDO
   ENDDO

   DO K=0,KBP1
      IF (EVACUATION_ONLY(NM) .AND. .NOT.(K==1)) CYCLE
      DO I=0,IBP1
         DO J=0,1
            IF (CELL_INDEX(I,J,K)==0) THEN
               CELL_COUNT(NM) = CELL_COUNT(NM) + 1
               CELL_INDEX(I,J,K) = CELL_COUNT(NM)
            ENDIF
         ENDDO
         DO J=JBAR,JBP1
            IF (CELL_INDEX(I,J,K)==0) THEN
               CELL_COUNT(NM) = CELL_COUNT(NM) + 1
               CELL_INDEX(I,J,K) = CELL_COUNT(NM)
            ENDIF
         ENDDO
      ENDDO
   ENDDO

   DO J=0,JBP1
      DO I=0,IBP1
         DO K=0,1
            IF (EVACUATION_ONLY(NM) .AND. .NOT.(K==1)) CYCLE
            IF (CELL_INDEX(I,J,K)==0) THEN
               CELL_COUNT(NM) = CELL_COUNT(NM) + 1
               CELL_INDEX(I,J,K) = CELL_COUNT(NM)
            ENDIF
         ENDDO
         DO K=KBAR,KBP1
            IF (EVACUATION_ONLY(NM) .AND. .NOT.(K==1)) CYCLE
            IF (CELL_INDEX(I,J,K)==0) THEN
               CELL_COUNT(NM) = CELL_COUNT(NM) + 1
               CELL_INDEX(I,J,K) = CELL_COUNT(NM)
            ENDIF
         ENDDO
      ENDDO
   ENDDO

   DO N=1,N_OBST
      OB=>OBSTRUCTION(N)
      DO K=OB%K1,OB%K2+1
         IF (EVACUATION_ONLY(NM) .AND. .NOT.(K==1)) CYCLE
         DO J=OB%J1,OB%J2+1
            DO I=OB%I1,OB%I2+1
               IF (CELL_INDEX(I,J,K)==0) THEN
                  CELL_COUNT(NM) = CELL_COUNT(NM) + 1
                  CELL_INDEX(I,J,K) = CELL_COUNT(NM)
               ENDIF
            ENDDO
         ENDDO
      ENDDO
   ENDDO

   ! Store in SOLID which cells are solid and which are not

   ALLOCATE(M%SOLID(0:CELL_COUNT(NM)),STAT=IZERO)
   CALL ChkMemErr('READ','SOLID',IZERO)
   M%SOLID = .FALSE.
   ALLOCATE(M%EXTERIOR(0:CELL_COUNT(NM)),STAT=IZERO)
   CALL ChkMemErr('READ','EXTERIOR',IZERO)
   M%EXTERIOR = .FALSE.
   SOLID=>M%SOLID
   ALLOCATE(M%OBST_INDEX_C(0:CELL_COUNT(NM)),STAT=IZERO)
   CALL ChkMemErr('READ','OBST_INDEX_C',IZERO)
   M%OBST_INDEX_C = 0
   OBST_INDEX_C=>M%OBST_INDEX_C

   ! Make all exterior cells solid

   CALL BLOCK_CELL(NM,   0,   0,   0,JBP1,   0,KBP1,1,0)
   CALL BLOCK_CELL(NM,IBP1,IBP1,   0,JBP1,   0,KBP1,1,0)
   CALL BLOCK_CELL(NM,   0,IBP1,   0,   0,   0,KBP1,1,0)
   CALL BLOCK_CELL(NM,   0,IBP1,JBP1,JBP1,   0,KBP1,1,0)
   CALL BLOCK_CELL(NM,   0,IBP1,   0,JBP1,   0,   0,1,0)
   CALL BLOCK_CELL(NM,   0,IBP1,   0,JBP1,KBP1,KBP1,1,0)

   ! Block off cells filled by obstructions

   DO N=1,N_OBST
      OB=>OBSTRUCTION(N)
      CALL BLOCK_CELL(NM,OB%I1+1,OB%I2,OB%J1+1,OB%J2,OB%K1+1,OB%K2,1,N)
   ENDDO

   ! Create arrays to hold cell indices

   ALLOCATE(M%I_CELL(CELL_COUNT(NM)),STAT=IZERO)
   CALL ChkMemErr('READ','I_CELL',IZERO)
   M%I_CELL = -1
   ALLOCATE(M%J_CELL(CELL_COUNT(NM)),STAT=IZERO)
   CALL ChkMemErr('READ','J_CELL',IZERO)
   M%J_CELL = -1
   ALLOCATE(M%K_CELL(CELL_COUNT(NM)),STAT=IZERO)
   CALL ChkMemErr('READ','K_CELL',IZERO)
   M%K_CELL = -1
   I_CELL=>M%I_CELL
   J_CELL=>M%J_CELL
   K_CELL=>M%K_CELL

   DO K=0,KBP1
      DO J=0,JBP1
         DO I=0,IBP1
         IC = CELL_INDEX(I,J,K)
            IF (IC>0) THEN
               I_CELL(IC) = I
               J_CELL(IC) = J
               K_CELL(IC) = K
            ENDIF
         ENDDO
      ENDDO
   ENDDO

ENDDO MESH_LOOP_3

CONTAINS

  SUBROUTINE DEFINE_EVACUATION_OBSTS(NM,IMODE,EVAC_N)
    !
    ! Define the evacuation OBSTs for the doors/exits, if needed.  A VENT should always
    ! be defined on an OBST that is at least one grid cell thick or the VENT should be
    ! on the outer boundary of the evacuation mesh, which is by default solid.
    ! The core of the STRS meshes are also defined.
    !
    USE EVAC, ONLY: N_DOORS, N_EXITS, N_CO_EXITS, EVAC_EMESH_EXITS_TYPE, EMESH_EXITS, &
         N_STRS, EMESH_STAIRS, EVAC_EMESH_STAIRS_TYPE
    IMPLICIT NONE
    ! Passed variables
    INTEGER, INTENT(IN) :: NM, IMODE, EVAC_N
    ! Local variables
    INTEGER :: N, N_END, I1, I2, J1, J2
    REAL(EB) :: TINY

    TINY = 0.1_EB*MIN(MESHES(NM)%DXI, MESHES(NM)%DETA)
    N_END = N_EXITS - N_CO_EXITS + N_DOORS
    IMODE_1_IF: IF (IMODE==1) THEN
       NEND_LOOP_1: DO N = 1, N_END

          IF (.NOT.EMESH_EXITS(N)%DEFINE_MESH) CYCLE NEND_LOOP_1
          IF (EMESH_EXITS(N)%IMESH==NM .OR. EMESH_EXITS(N)%MAINMESH==NM) THEN
             EMESH_EXITS(N)%I_OBST = 0

             ! Move EMESH_EXITS(N)%XB to mesh cell boundaries
             EMESH_EXITS(N)%XB(1) = MAX(EMESH_EXITS(N)%XB(1),MESHES(NM)%XS)
             EMESH_EXITS(N)%XB(2) = MIN(EMESH_EXITS(N)%XB(2),MESHES(NM)%XF)
             EMESH_EXITS(N)%XB(3) = MAX(EMESH_EXITS(N)%XB(3),MESHES(NM)%YS)
             EMESH_EXITS(N)%XB(4) = MIN(EMESH_EXITS(N)%XB(4),MESHES(NM)%YF)

             I1 = NINT(GINV(EMESH_EXITS(N)%XB(1)-MESHES(NM)%XS,1,NM)*MESHES(NM)%RDXI )
             I2 = NINT(GINV(EMESH_EXITS(N)%XB(2)-MESHES(NM)%XS,1,NM)*MESHES(NM)%RDXI )
             J1 = NINT(GINV(EMESH_EXITS(N)%XB(3)-MESHES(NM)%YS,2,NM)*MESHES(NM)%RDETA)
             J2 = NINT(GINV(EMESH_EXITS(N)%XB(4)-MESHES(NM)%YS,2,NM)*MESHES(NM)%RDETA)

             EMESH_EXITS(N)%XB(1) = MESHES(NM)%X(I1)
             EMESH_EXITS(N)%XB(2) = MESHES(NM)%X(I2)
             EMESH_EXITS(N)%XB(3) = MESHES(NM)%Y(J1)
             EMESH_EXITS(N)%XB(4) = MESHES(NM)%Y(J2)

             ! Check if the exit/door is at the mesh boundary, then no OBST is needed.
             SELECT CASE (EMESH_EXITS(N)%IOR)
             CASE (-1)
                IF (MESHES(NM)%XS >= EMESH_EXITS(N)%XB(1)-TINY) CYCLE NEND_LOOP_1
             CASE (+1)
                IF (MESHES(NM)%XF <= EMESH_EXITS(N)%XB(2)+TINY) CYCLE NEND_LOOP_1
             CASE (-2)
                IF (MESHES(NM)%YS >= EMESH_EXITS(N)%XB(3)-TINY) CYCLE NEND_LOOP_1
             CASE (+2)
                IF (MESHES(NM)%YF <= EMESH_EXITS(N)%XB(4)+TINY) CYCLE NEND_LOOP_1
             END SELECT
             N_OBST_DIM = N_OBST_DIM + 1
             N_OBST_O   = N_OBST_O   + 1
             EMESH_EXITS(N)%I_OBST = N_OBST_O
             EVACUATION_OBST = .TRUE.
          END IF
       END DO NEND_LOOP_1

       NSTRS_LOOP_1: DO N = 1, N_STRS

          IF (.NOT.EMESH_STAIRS(N)%DEFINE_MESH) CYCLE NSTRS_LOOP_1
          IF (EMESH_STAIRS(N)%IMESH==NM) THEN

             ! Move EMESH_STAIRS(N)%XB_CORE to mesh cell boundaries
             EMESH_STAIRS(N)%XB_CORE(1) = MAX(EMESH_STAIRS(N)%XB_CORE(1),MESHES(NM)%XS)
             EMESH_STAIRS(N)%XB_CORE(2) = MIN(EMESH_STAIRS(N)%XB_CORE(2),MESHES(NM)%XF)
             EMESH_STAIRS(N)%XB_CORE(3) = MAX(EMESH_STAIRS(N)%XB_CORE(3),MESHES(NM)%YS)
             EMESH_STAIRS(N)%XB_CORE(4) = MIN(EMESH_STAIRS(N)%XB_CORE(4),MESHES(NM)%YF)

             I1 = NINT(GINV(EMESH_STAIRS(N)%XB_CORE(1)-MESHES(NM)%XS,1,NM)*MESHES(NM)%RDXI )
             I2 = NINT(GINV(EMESH_STAIRS(N)%XB_CORE(2)-MESHES(NM)%XS,1,NM)*MESHES(NM)%RDXI )
             J1 = NINT(GINV(EMESH_STAIRS(N)%XB_CORE(3)-MESHES(NM)%YS,2,NM)*MESHES(NM)%RDETA)
             J2 = NINT(GINV(EMESH_STAIRS(N)%XB_CORE(4)-MESHES(NM)%YS,2,NM)*MESHES(NM)%RDETA)

             EMESH_STAIRS(N)%XB_CORE(1) = MESHES(NM)%X(I1)
             EMESH_STAIRS(N)%XB_CORE(2) = MESHES(NM)%X(I2)
             EMESH_STAIRS(N)%XB_CORE(3) = MESHES(NM)%Y(J1)
             EMESH_STAIRS(N)%XB_CORE(4) = MESHES(NM)%Y(J2)

             N_OBST_DIM = N_OBST_DIM + 1
             N_OBST_O   = N_OBST_O   + 1
             EMESH_STAIRS(N)%I_OBST = N_OBST_O
             EVACUATION_OBST = .TRUE.
          END IF
       END DO NSTRS_LOOP_1

    END IF IMODE_1_IF

    IMODE_2_IF: IF (IMODE==2) THEN
       NEND_LOOP_2: DO N = 1, N_END
          IF (.NOT.EMESH_EXITS(N)%DEFINE_MESH) CYCLE NEND_LOOP_2
          IF (EMESH_EXITS(N)%I_OBST==EVAC_N .AND. (EMESH_EXITS(N)%IMESH==NM .OR. EMESH_EXITS(N)%MAINMESH==NM)) THEN
             EVACUATION_OBST = .TRUE.
             EVACUATION = .TRUE.
             REMOVABLE = .FALSE.
             THICKEN = .TRUE.
             PERMIT_HOLE = .FALSE.
             ALLOW_VENT = .TRUE.
             MESH_ID = TRIM(MESH_NAME(NM))
             XB(1) = EMESH_EXITS(N)%XB(1)
             XB(2) = EMESH_EXITS(N)%XB(2)
             XB(3) = EMESH_EXITS(N)%XB(3)
             XB(4) = EMESH_EXITS(N)%XB(4)
             XB(5) = EMESH_EXITS(N)%XB(5)
             XB(6) = EMESH_EXITS(N)%XB(6)
             SELECT CASE (EMESH_EXITS(N)%IOR)
             CASE (-1)
                XB(1) = MAX(MESHES(NM)%XS, XB(1) - 0.49_EB*MESHES(NM)%DXI)
             CASE (+1)
                XB(2) = MIN(MESHES(NM)%XF, XB(2) + 0.49_EB*MESHES(NM)%DXI)
             CASE (-2)
                XB(3) = MAX(MESHES(NM)%YS, XB(3) - 0.49_EB*MESHES(NM)%DETA)
             CASE (+2)
                XB(4) = MIN(MESHES(NM)%YF, XB(4) + 0.49_EB*MESHES(NM)%DETA)
             END SELECT
             RGB(:) = EMESH_EXITS(N)%RGB(:)
             ID = TRIM('Eobst_' // TRIM(MESH_NAME(NM)))
          END IF
       END DO NEND_LOOP_2

       NSTRS_LOOP_2: DO N = 1, N_STRS
          IF (.NOT.EMESH_STAIRS(N)%DEFINE_MESH) CYCLE NSTRS_LOOP_2
          IF (EMESH_STAIRS(N)%I_OBST==EVAC_N .AND. EMESH_STAIRS(N)%IMESH==NM) THEN
             EVACUATION_OBST = .TRUE.
             EVACUATION = .TRUE.
             REMOVABLE = .FALSE.
             ! THICKEN = .TRUE.
             PERMIT_HOLE = .FALSE.
             ALLOW_VENT = .FALSE.
             MESH_ID = TRIM(MESH_NAME(NM))
             XB(1) = EMESH_STAIRS(N)%XB_CORE(1)
             XB(2) = EMESH_STAIRS(N)%XB_CORE(2)
             XB(3) = EMESH_STAIRS(N)%XB_CORE(3)
             XB(4) = EMESH_STAIRS(N)%XB_CORE(4)
             XB(5) = EMESH_STAIRS(N)%XB(5)
             XB(6) = EMESH_STAIRS(N)%XB(6)
             RGB(:) = EMESH_STAIRS(N)%RGB(:)
             ID = TRIM('Eobst_' // TRIM(MESH_NAME(NM)))
          END IF
       END DO NSTRS_LOOP_2

    END IF IMODE_2_IF

    RETURN
  END SUBROUTINE DEFINE_EVACUATION_OBSTS

END SUBROUTINE READ_OBST


!> \brief Read the HOLE namelist lines

SUBROUTINE READ_HOLE

USE MISC_FUNCTIONS, ONLY: PROCESS_MESH_NEIGHBORHOOD
CHARACTER(LABEL_LENGTH) :: DEVC_ID,CTRL_ID,MULT_ID
CHARACTER(LABEL_LENGTH) :: MESH_ID
CHARACTER(25) :: COLOR
LOGICAL :: EVACUATION_HOLE,EVACUATION,BLOCK_WIND
INTEGER :: NM,N_HOLE,NN,NDO,N,I1,I2,J1,J2,K1,K2,RGB(3),N_HOLE_NEW,N_HOLE_O,II,JJ,KK,NNN,DEVC_INDEX_O,CTRL_INDEX_O
REAL(EB) :: X1,X2,Y1,Y2,Z1,Z2,TRANSPARENCY
NAMELIST /HOLE/ BLOCK_WIND,COLOR,CTRL_ID,DEVC_ID,EVACUATION,FYI,ID,MESH_ID,MULT_ID,RGB,TRANSPARENCY,XB
REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: TEMP_XB
LOGICAL, ALLOCATABLE, DIMENSION(:) :: CONTROLLED
TYPE(OBSTRUCTION_TYPE), ALLOCATABLE, DIMENSION(:) :: TEMP_OBST
TYPE(MULTIPLIER_TYPE), POINTER :: MR=>NULL()
LOGICAL, ALLOCATABLE, DIMENSION(:) :: TEMP_HOLE_EVAC

ALLOCATE(TEMP_OBST(0:6))

N_HOLE    = 0
N_HOLE_O  = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

COUNT_LOOP: DO
   CALL CHECKREAD('HOLE',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_LOOP
   MULT_ID = 'null'
   READ(LU_INPUT,NML=HOLE,END=1,ERR=2,IOSTAT=IOS)
   N_HOLE_O = N_HOLE_O + 1
   N_HOLE_NEW = 0
   IF (MULT_ID=='null') THEN
      N_HOLE_NEW = 1
   ELSE
      DO N=1,N_MULT
         MR => MULTIPLIER(N)
         IF (MULT_ID==MR%ID) N_HOLE_NEW = MR%N_COPIES
      ENDDO
      IF (N_HOLE_NEW==0) THEN
         WRITE(MESSAGE,'(A,A,A,I0)') 'ERROR: MULT line ', TRIM(MULT_ID),' not found on HOLE line', N_HOLE_O
         CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
      ENDIF
   ENDIF
   N_HOLE   = N_HOLE   + N_HOLE_NEW
   2 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)')  'ERROR: Problem with HOLE number',N_HOLE_O+1,', line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
   ENDIF
ENDDO COUNT_LOOP
1 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

CALL DEFINE_EVACUATION_HOLES(1)

ALLOCATE (TEMP_XB(N_HOLE_O,6))
TEMP_XB = 0._EB
ALLOCATE (CONTROLLED(N_HOLE_O))
CONTROLLED = .FALSE.

! TEMP_HOLE_EVAC(:) indicates if the given HOLE is to be used in the EVACUATION routine

IF (ANY(EVACUATION_ONLY)) THEN
   ALLOCATE(TEMP_HOLE_EVAC(1:N_HOLE_O))
   READ_HOLE_EVAC_LOOP: DO N=1,N_HOLE_O
      EVACUATION_HOLE = .FALSE.
      CALL DEFINE_EVACUATION_HOLES(2)
      EVACUATION = .TRUE.
      IF (.NOT.EVACUATION_HOLE) THEN
         CALL CHECKREAD('HOLE',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
         IF (IOS==1) EXIT READ_HOLE_EVAC_LOOP
         READ(LU_INPUT,HOLE)
      END IF
      TEMP_HOLE_EVAC(N) = EVACUATION
   ENDDO READ_HOLE_EVAC_LOOP
   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
ENDIF

READ_HOLE_LOOP: DO N=1,N_HOLE_O

   ! Set default values for the HOLE namelist parameters

   BLOCK_WIND = .FALSE.
   DEVC_ID  = 'null'
   CTRL_ID  = 'null'
   ID       = 'null'
   MESH_ID  = 'null'
   MULT_ID  = 'null'
   COLOR    = 'null'
   RGB      = -1
   TRANSPARENCY = 1._EB
   EVACUATION   = .FALSE.
   XB       = -9.E30_EB

   ! Read the HOLE line

   EVACUATION_HOLE = .FALSE.
   IF (ANY(EVACUATION_ONLY)) CALL DEFINE_EVACUATION_HOLES(3)
   EVACUATION_HOLES: IF (.NOT. EVACUATION_HOLE) THEN
      CALL CHECKREAD('HOLE',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT READ_HOLE_LOOP
      READ(LU_INPUT,HOLE)
   END IF EVACUATION_HOLES

   ! Re-order coordinates, if necessary

   CALL CHECK_XB(XB)
   TEMP_XB(N,:) = XB
   ! Check for overlap if controlled
   IF (DEVC_ID/='null' .OR. CTRL_ID/='null') CONTROLLED(N) = .TRUE.
   IF (N>1) THEN
      DO NN = 1,N-1
         IF (TEMP_XB(NN,1) >= XB(2) .OR. TEMP_XB(NN,3) >= XB(4) .OR. TEMP_XB(NN,5) >= XB(6) .OR. &
             TEMP_XB(NN,2) <= XB(1) .OR. TEMP_XB(NN,4) <= XB(3) .OR. TEMP_XB(NN,6) <= XB(5)) CYCLE
         IF ((TEMP_XB(NN,1) <= XB(2) .AND. TEMP_XB(NN,2) >= XB(1)) .AND. &
             (TEMP_XB(NN,3) <= XB(4) .AND. TEMP_XB(NN,4) >= XB(3)) .AND. &
             (TEMP_XB(NN,5) <= XB(6) .AND. TEMP_XB(NN,6) >= XB(5))) THEN
            IF (CONTROLLED(N) .OR. CONTROLLED(NN)) THEN
               WRITE(MESSAGE,'(A,I0,A,I0)')  'ERROR: Cannot overlap HOLEs with a DEVC_ID or CTRL_ID. HOLE number ',N_HOLE_O+1,&
                                             ', line number ',INPUT_FILE_LINE_NUMBER
               CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
            ENDIF
         ENDIF
      ENDDO
   ENDIF

   ! Loop over all the meshes to determine where the HOLE is

   MESH_LOOP: DO NM=1,NMESHES

      IF (.NOT.PROCESS_MESH_NEIGHBORHOOD(NM) .AND. MYID/=EVAC_PROCESS) CYCLE MESH_LOOP

      M=>MESHES(NM)
      CALL POINT_TO_MESH(NM)

      ! Evacuation criteria

      IF (MESH_ID/='null' .AND. MESH_ID/=MESH_NAME(NM)) CYCLE MESH_LOOP
      IF (EVACUATION .AND. .NOT.EVACUATION_ONLY(NM)) CYCLE MESH_LOOP
      IF (EVACUATION_ONLY(NM)) THEN
         IF (.NOT.TEMP_HOLE_EVAC(N)) CYCLE MESH_LOOP
         DEVC_ID    = 'null'
         CTRL_ID    = 'null'
      ENDIF

      ! Loop over all possible multiples of the HOLE

      MR => MULTIPLIER(0)
      DO NNN=1,N_MULT
         IF (MULT_ID==MULTIPLIER(NNN)%ID) MR => MULTIPLIER(NNN)
      ENDDO

      K_MULT_LOOP: DO KK=MR%K_LOWER,MR%K_UPPER
         J_MULT_LOOP: DO JJ=MR%J_LOWER,MR%J_UPPER
            I_MULT_LOOP: DO II=MR%I_LOWER,MR%I_UPPER

               IF (MR%SKIP(II,JJ,KK)) CYCLE I_MULT_LOOP

               IF (.NOT.MR%SEQUENTIAL) THEN
                  X1 = XB(1) + MR%DX0 + II*MR%DXB(1)
                  X2 = XB(2) + MR%DX0 + II*MR%DXB(2)
                  Y1 = XB(3) + MR%DY0 + JJ*MR%DXB(3)
                  Y2 = XB(4) + MR%DY0 + JJ*MR%DXB(4)
                  Z1 = XB(5) + MR%DZ0 + KK*MR%DXB(5)
                  Z2 = XB(6) + MR%DZ0 + KK*MR%DXB(6)
               ELSE
                  X1 = XB(1) + MR%DX0 + II*MR%DXB(1)
                  X2 = XB(2) + MR%DX0 + II*MR%DXB(2)
                  Y1 = XB(3) + MR%DY0 + II*MR%DXB(3)
                  Y2 = XB(4) + MR%DY0 + II*MR%DXB(4)
                  Z1 = XB(5) + MR%DZ0 + II*MR%DXB(5)
                  Z2 = XB(6) + MR%DZ0 + II*MR%DXB(6)
               ENDIF

               ! Check if hole is contained within the current mesh

               IF (X1>=XF .OR. X2<=XS .OR. Y1>YF .OR. Y2<=YS .OR. Z1>ZF .OR. Z2<=ZS) CYCLE I_MULT_LOOP

               ! Assign mesh-limited bounds

               X1 = MAX(X1,XS-0.001_EB*DX(0))
               X2 = MIN(X2,XF+0.001_EB*DX(IBP1))
               Y1 = MAX(Y1,YS-0.001_EB*DY(0))
               Y2 = MIN(Y2,YF+0.001_EB*DY(JBP1))
               Z1 = MAX(Z1,ZS-0.001_EB*DZ(0))
               Z2 = MIN(Z2,ZF+0.001_EB*DZ(KBP1))

               I1 = NINT( GINV(X1-XS,1,NM)*RDXI   )
               I2 = NINT( GINV(X2-XS,1,NM)*RDXI   )
               J1 = NINT( GINV(Y1-YS,2,NM)*RDETA  )
               J2 = NINT( GINV(Y2-YS,2,NM)*RDETA  )
               K1 = NINT( GINV(Z1-ZS,3,NM)*RDZETA )
               K2 = NINT( GINV(Z2-ZS,3,NM)*RDZETA )

               ! Remove mean forcing in hole region

               IF (ANY(MEAN_FORCING) .AND. BLOCK_WIND) THEN
                  DO K=K1,K2+1
                     DO J=J1,J2+1
                        DO I=I1,I2+1
                           M%MEAN_FORCING_CELL(I,J,K) = .FALSE.
                        ENDDO
                     ENDDO
                  ENDDO
                  CYCLE I_MULT_LOOP
               ENDIF

               NN=0
               OBST_LOOP: DO
                  NN=NN+1
                  IF (NN>N_OBST) EXIT OBST_LOOP
                  OB=>OBSTRUCTION(NN)
                  DEVC_INDEX_O = OB%DEVC_INDEX
                  CTRL_INDEX_O = OB%CTRL_INDEX
                  IF (.NOT.OB%PERMIT_HOLE) CYCLE OBST_LOOP

                  ! TEMP_OBST(0) is the intersection of HOLE and OBST

                  TEMP_OBST(0)    = OBSTRUCTION(NN)

                  TEMP_OBST(0)%I1 = MAX(I1,OB%I1)
                  TEMP_OBST(0)%I2 = MIN(I2,OB%I2)
                  TEMP_OBST(0)%J1 = MAX(J1,OB%J1)
                  TEMP_OBST(0)%J2 = MIN(J2,OB%J2)
                  TEMP_OBST(0)%K1 = MAX(K1,OB%K1)
                  TEMP_OBST(0)%K2 = MIN(K2,OB%K2)

                  TEMP_OBST(0)%X1 = MAX(X1,OB%X1)
                  TEMP_OBST(0)%X2 = MIN(X2,OB%X2)
                  TEMP_OBST(0)%Y1 = MAX(Y1,OB%Y1)
                  TEMP_OBST(0)%Y2 = MIN(Y2,OB%Y2)
                  TEMP_OBST(0)%Z1 = MAX(Z1,OB%Z1)
                  TEMP_OBST(0)%Z2 = MIN(Z2,OB%Z2)

                  ! Ignore OBSTs that do not intersect with HOLE or are merely sliced by the hole.

                  IF (TEMP_OBST(0)%I2-TEMP_OBST(0)%I1<0 .OR. TEMP_OBST(0)%J2-TEMP_OBST(0)%J1<0 .OR. &
                      TEMP_OBST(0)%K2-TEMP_OBST(0)%K1<0) CYCLE OBST_LOOP
                  IF (TEMP_OBST(0)%I2-TEMP_OBST(0)%I1==0) THEN
                     IF (OB%I1<TEMP_OBST(0)%I1 .OR.  OB%I2>TEMP_OBST(0)%I2) CYCLE OBST_LOOP
                  ENDIF
                  IF (TEMP_OBST(0)%J2-TEMP_OBST(0)%J1==0) THEN
                     IF (OB%J1<TEMP_OBST(0)%J1 .OR.  OB%J2>TEMP_OBST(0)%J2) CYCLE OBST_LOOP
                  ENDIF
                  IF (TEMP_OBST(0)%K2-TEMP_OBST(0)%K1==0) THEN
                     IF (OB%K1<TEMP_OBST(0)%K1 .OR.  OB%K2>TEMP_OBST(0)%K2) CYCLE OBST_LOOP
                  ENDIF

                  IF (TEMP_OBST(0)%X2<=X1 .OR. TEMP_OBST(0)%X1>=X2 .OR. TEMP_OBST(0)%Y2<=Y1 .OR. TEMP_OBST(0)%Y1>=Y2 .OR. &
                     TEMP_OBST(0)%Z2<=Z1 .OR. TEMP_OBST(0)%Z1>=Z2)  CYCLE OBST_LOOP

                  ! Start counting new OBSTs that need to be created

                  NDO=0

                  IF ((OB%I1<I1.AND.I1<OB%I2) .OR. (XB(1)>=XS.AND.I1==0.AND.OB%I1==0)) THEN
                     NDO=NDO+1
                     TEMP_OBST(NDO)=OBSTRUCTION(NN)
                     TEMP_OBST(NDO)%I1 = OB%I1
                     TEMP_OBST(NDO)%I2 = I1
                     TEMP_OBST(NDO)%X1 = OB%X1
                     TEMP_OBST(NDO)%X2 = X1
                  ENDIF

                  IF ((OB%I1<I2.AND.I2<OB%I2) .OR. (XB(2)<=XF.AND.I2==IBAR.AND.OB%I2==IBAR)) THEN
                     NDO=NDO+1
                     TEMP_OBST(NDO)=OBSTRUCTION(NN)
                     TEMP_OBST(NDO)%I1 = I2
                     TEMP_OBST(NDO)%I2 = OB%I2
                     TEMP_OBST(NDO)%X1 = X2
                     TEMP_OBST(NDO)%X2 = OB%X2
                  ENDIF

                  IF ((OB%J1<J1.AND.J1<OB%J2) .OR. (XB(3)>=YS.AND.J1==0.AND.OB%J1==0)) THEN
                     NDO=NDO+1
                     TEMP_OBST(NDO)=OBSTRUCTION(NN)
                     TEMP_OBST(NDO)%I1 = MAX(I1,OB%I1)
                     TEMP_OBST(NDO)%I2 = MIN(I2,OB%I2)
                     TEMP_OBST(NDO)%X1 = MAX(X1,OB%X1)
                     TEMP_OBST(NDO)%X2 = MIN(X2,OB%X2)
                     TEMP_OBST(NDO)%J1 = OB%J1
                     TEMP_OBST(NDO)%J2 = J1
                     TEMP_OBST(NDO)%Y1 = OB%Y1
                     TEMP_OBST(NDO)%Y2 = Y1
                  ENDIF

                  IF ((OB%J1<J2.AND.J2<OB%J2) .OR. (XB(4)<=YF.AND.J2==JBAR.AND.OB%J2==JBAR)) THEN
                     NDO=NDO+1
                     TEMP_OBST(NDO)=OBSTRUCTION(NN)
                     TEMP_OBST(NDO)%I1 = MAX(I1,OB%I1)
                     TEMP_OBST(NDO)%I2 = MIN(I2,OB%I2)
                     TEMP_OBST(NDO)%X1 = MAX(X1,OB%X1)
                     TEMP_OBST(NDO)%X2 = MIN(X2,OB%X2)
                     TEMP_OBST(NDO)%J1 = J2
                     TEMP_OBST(NDO)%J2 = OB%J2
                     TEMP_OBST(NDO)%Y1 = Y2
                     TEMP_OBST(NDO)%Y2 = OB%Y2
                  ENDIF

                  IF ((OB%K1<K1.AND.K1<OB%K2) .OR. (XB(5)>=ZS.AND.K1==0.AND.OB%K1==0)) THEN
                     NDO=NDO+1
                     TEMP_OBST(NDO)=OBSTRUCTION(NN)
                     TEMP_OBST(NDO)%I1 = MAX(I1,OB%I1)
                     TEMP_OBST(NDO)%I2 = MIN(I2,OB%I2)
                     TEMP_OBST(NDO)%X1 = MAX(X1,OB%X1)
                     TEMP_OBST(NDO)%X2 = MIN(X2,OB%X2)
                     TEMP_OBST(NDO)%J1 = MAX(J1,OB%J1)
                     TEMP_OBST(NDO)%J2 = MIN(J2,OB%J2)
                     TEMP_OBST(NDO)%Y1 = MAX(Y1,OB%Y1)
                     TEMP_OBST(NDO)%Y2 = MIN(Y2,OB%Y2)
                     TEMP_OBST(NDO)%K1 = OB%K1
                     TEMP_OBST(NDO)%K2 = K1
                     TEMP_OBST(NDO)%Z1 = OB%Z1
                     TEMP_OBST(NDO)%Z2 = Z1
                  ENDIF

                  IF ((OB%K1<K2.AND.K2<OB%K2) .OR. (XB(6)<=ZF.AND.K2==KBAR.AND.OB%K2==KBAR)) THEN
                     NDO=NDO+1
                     TEMP_OBST(NDO)=OBSTRUCTION(NN)
                     TEMP_OBST(NDO)%I1 = MAX(I1,OB%I1)
                     TEMP_OBST(NDO)%I2 = MIN(I2,OB%I2)
                     TEMP_OBST(NDO)%X1 = MAX(X1,OB%X1)
                     TEMP_OBST(NDO)%X2 = MIN(X2,OB%X2)
                     TEMP_OBST(NDO)%J1 = MAX(J1,OB%J1)
                     TEMP_OBST(NDO)%J2 = MIN(J2,OB%J2)
                     TEMP_OBST(NDO)%Y1 = MAX(Y1,OB%Y1)
                     TEMP_OBST(NDO)%Y2 = MIN(Y2,OB%Y2)
                     TEMP_OBST(NDO)%K1 = K2
                     TEMP_OBST(NDO)%K2 = OB%K2
                     TEMP_OBST(NDO)%Z1 = Z2
                     TEMP_OBST(NDO)%Z2 = OB%Z2
                  ENDIF

                  ! Maintain ordinal rank of original obstruction, but negate it. This will be a code for Smokeview.

                  TEMP_OBST(:)%ORDINAL = -OB%ORDINAL

                  ! Re-allocate space of new OBSTs, or remove entry for dead OBST

                  NEW_OBST_IF: IF (NDO>0) THEN
                        CALL RE_ALLOCATE_OBST(NM,N_OBST,NDO)
                        OBSTRUCTION=>M%OBSTRUCTION
                        OBSTRUCTION(N_OBST+1:N_OBST+NDO) = TEMP_OBST(1:NDO)
                        N_OBST = N_OBST + NDO
                  ENDIF NEW_OBST_IF

                  ! If the HOLE is to be created or removed, save it in OBSTRUCTION(NN), the original OBST that was broken up

                  DEVC_OR_CTRL: IF (DEVC_ID/='null' .OR. CTRL_ID/='null') THEN

                     OBSTRUCTION(NN) = TEMP_OBST(0)
                     OB => OBSTRUCTION(NN)
                     OB%DEVC_INDEX_O = DEVC_INDEX_O
                     OB%CTRL_INDEX_O = CTRL_INDEX_O
                     OB%DEVC_ID = DEVC_ID
                     OB%CTRL_ID = CTRL_ID
                     CALL SEARCH_CONTROLLER('HOLE',CTRL_ID,DEVC_ID,OB%DEVC_INDEX,OB%CTRL_INDEX,N)
                     IF (DEVC_ID/='null' .OR. CTRL_ID /='null') THEN
                        OB%REMOVABLE   = .TRUE.
                        OB%HOLE_FILLER = .TRUE.
                        IF (DEVC_ID/='null') OB%CTRL_INDEX = -1
                        IF (CTRL_ID/='null') OB%DEVC_INDEX = -1
                     ENDIF
                     IF (OB%CONSUMABLE)    OB%REMOVABLE = .TRUE.

                     SELECT CASE (COLOR)
                        CASE ('INVISIBLE')
                           OB%COLOR_INDICATOR = -3
                           OB%RGB(1) = 255
                           OB%RGB(2) = 204
                           OB%RGB(3) = 102
                           OB%TRANSPARENCY = 0._EB
                        CASE ('null')
                           IF (ANY(RGB>0)) THEN
                              OB%COLOR_INDICATOR = -3
                              OB%RGB  = RGB
                              OB%TRANSPARENCY = TRANSPARENCY
                           ENDIF
                        CASE DEFAULT
                           CALL COLOR2RGB(RGB,COLOR)
                           OB%COLOR_INDICATOR = -3
                           OB%RGB  = RGB
                           OB%TRANSPARENCY = TRANSPARENCY
                     END SELECT

                  ELSE DEVC_OR_CTRL

                     OBSTRUCTION(NN) = OBSTRUCTION(N_OBST)
                     N_OBST = N_OBST-1
                     NN = NN-1

                  ENDIF DEVC_OR_CTRL

               ENDDO OBST_LOOP
            ENDDO I_MULT_LOOP
         ENDDO J_MULT_LOOP
      ENDDO K_MULT_LOOP
   ENDDO MESH_LOOP
ENDDO READ_HOLE_LOOP

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF(ANY(EVACUATION_ONLY)) DEALLOCATE(TEMP_HOLE_EVAC)
DEALLOCATE(TEMP_OBST)
DEALLOCATE (CONTROLLED)
DEALLOCATE (TEMP_XB)

CONTAINS

  SUBROUTINE DEFINE_EVACUATION_HOLES(IMODE)
    !
    ! Clear the STRS meshes by a hole with size of XB of the stairs.
    ! The core is put there applying permit_hole=false.
    USE EVAC, ONLY: N_STRS, EMESH_STAIRS, EVAC_EMESH_STAIRS_TYPE
    IMPLICIT NONE
    ! Passed variables
    INTEGER, INTENT(IN) :: IMODE
    ! Local variables
    INTEGER :: I
    REAL(EB) :: TINY_X, TINY_Y, TINY_Z

    IF (.NOT.ANY(EVACUATION_ONLY)) RETURN
    IMODE_1_IF: IF (IMODE==1) THEN
       NSTRS_LOOP_1: DO I = 1, N_STRS
          IF (.NOT.EMESH_STAIRS(I)%DEFINE_MESH) CYCLE NSTRS_LOOP_1
          N_HOLE_O = N_HOLE_O + 1
          N_HOLE   = N_HOLE   + 1 ! No mult for evacuation strs meshes
          EMESH_STAIRS(I)%I_HOLE = N_HOLE_O
          EVACUATION_HOLE = .TRUE.
       END DO NSTRS_LOOP_1
    END IF IMODE_1_IF

    IMODE_2_IF: IF (IMODE==2) THEN
       EVACUATION_HOLE = .FALSE.
       NSTRS_LOOP_2: DO I = 1, N_STRS
          IF (.NOT.EMESH_STAIRS(I)%DEFINE_MESH) CYCLE NSTRS_LOOP_2
          IF (.NOT.EMESH_STAIRS(I)%I_HOLE==N) CYCLE NSTRS_LOOP_2
          EVACUATION_HOLE = .TRUE.
          EXIT NSTRS_LOOP_2
       END DO NSTRS_LOOP_2
    END IF IMODE_2_IF

    IMODE_3_IF: IF (IMODE==3) THEN
       EVACUATION_HOLE = .FALSE.
       NSTRS_LOOP_3: DO I = 1, N_STRS
          IF (.NOT.EMESH_STAIRS(I)%DEFINE_MESH) CYCLE NSTRS_LOOP_3
          IF (.NOT.EMESH_STAIRS(I)%I_HOLE==N) CYCLE NSTRS_LOOP_3
          EVACUATION_HOLE = .TRUE.
          RGB = EMESH_STAIRS(I)%RGB
          XB = EMESH_STAIRS(I)%XB
          TINY_X = 0.01_EB*(EMESH_STAIRS(I)%XB(2)-EMESH_STAIRS(I)%XB(1))/EMESH_STAIRS(I)%IBAR
          TINY_Y = 0.01_EB*(EMESH_STAIRS(I)%XB(4)-EMESH_STAIRS(I)%XB(3))/EMESH_STAIRS(I)%JBAR
          TINY_Z = 0.01_EB
          XB(1) = XB(1)-TINY_X ; XB(2) = XB(2)+TINY_X
          XB(3) = XB(3)-TINY_Y ; XB(4) = XB(4)+TINY_Y
          XB(5) = XB(5)-TINY_Z ; XB(6) = XB(6)+TINY_Z
          EVACUATION = .TRUE.
          MESH_ID = TRIM(MESH_NAME(EMESH_STAIRS(I)%IMESH))
          EXIT NSTRS_LOOP_3
       END DO NSTRS_LOOP_3
    END IF IMODE_3_IF

  END SUBROUTINE DEFINE_EVACUATION_HOLES

END SUBROUTINE READ_HOLE


SUBROUTINE RE_ALLOCATE_OBST(NM,N_OBST,NDO)

TYPE (OBSTRUCTION_TYPE), ALLOCATABLE, DIMENSION(:) :: DUMMY
INTEGER, INTENT(IN) :: NM,NDO,N_OBST
TYPE (MESH_TYPE), POINTER :: M=>NULL()
M=>MESHES(NM)
ALLOCATE(DUMMY(0:N_OBST))
DUMMY(0:N_OBST) = M%OBSTRUCTION(0:N_OBST)
DEALLOCATE(M%OBSTRUCTION)
ALLOCATE(M%OBSTRUCTION(0:N_OBST+NDO))
M%OBSTRUCTION(0:N_OBST) = DUMMY(0:N_OBST)
DEALLOCATE(DUMMY)
END SUBROUTINE RE_ALLOCATE_OBST


!> \brief Read the VENT namelist lines

SUBROUTINE READ_VENT

USE GEOMETRY_FUNCTIONS, ONLY : BLOCK_CELL,CIRCLE_CELL_INTERSECTION_AREA
USE DEVICE_VARIABLES, ONLY : DEVICE
USE CONTROL_VARIABLES, ONLY : CONTROL
USE MATH_FUNCTIONS, ONLY: GET_RAMP_INDEX
USE MISC_FUNCTIONS, ONLY: PROCESS_MESH_NEIGHBORHOOD

INTEGER :: N,N_TOTAL,N_EXPLICIT,NM,NNN,IOR,I1,I2,J1,J2,K1,K2,RGB(3),N_EDDY,II,JJ,KK,OBST_INDEX,N_IMPLICIT_VENTS,I_MODE
REAL(EB) :: SPREAD_RATE,TRANSPARENCY,XYZ(3),TMP_EXTERIOR,DYNAMIC_PRESSURE,XB_USER(6),XB_MESH(6), &
            REYNOLDS_STRESS(3,3),L_EDDY,VEL_RMS,L_EDDY_IJ(3,3),UVW(3),RADIUS
CHARACTER(LABEL_LENGTH) :: ID,DEVC_ID,CTRL_ID,SURF_ID,PRESSURE_RAMP,TMP_EXTERIOR_RAMP,MULT_ID,OBST_ID
CHARACTER(LABEL_LENGTH) :: MESH_ID
CHARACTER(25) :: COLOR
TYPE(MULTIPLIER_TYPE), POINTER :: MR
LOGICAL :: REJECT_VENT,EVACUATION,OUTLINE,GEOM
TYPE IMPLICIT_VENT_TYPE
   REAL(EB) :: XB(6)
   INTEGER, DIMENSION(3) :: RGB=-1
   CHARACTER(LABEL_LENGTH) :: MB='null',SURF_ID='null',ID='null',MESH_ID='null'
   LOGICAL :: EVACUATION=.FALSE.
END TYPE
TYPE(IMPLICIT_VENT_TYPE), ALLOCATABLE, DIMENSION(:) :: IMPLICIT_VENT
NAMELIST /VENT/ COLOR,CTRL_ID,DB,DEVC_ID,DYNAMIC_PRESSURE,EVACUATION,FYI,GEOM,ID,IOR,L_EDDY,L_EDDY_IJ, &
                MB,MESH_ID,MULT_ID,N_EDDY,OBST_ID,OUTLINE,PBX,PBY,PBZ,PRESSURE_RAMP,RADIUS,REYNOLDS_STRESS, &
                RGB,SPREAD_RATE,SURF_ID,TEXTURE_ORIGIN,TMP_EXTERIOR,TMP_EXTERIOR_RAMP,TRANSPARENCY, &
                UVW,VEL_RMS,XB,XYZ

! For a given MPI process, only read and process VENTs in the MESHes it controls or the MESH's immediate neighbors

MESH_LOOP_1: DO NM=1,NMESHES

   IF (.NOT.PROCESS_MESH_NEIGHBORHOOD(NM)) CYCLE MESH_LOOP_1

   CALL POINT_TO_MESH(NM)

   ! Special circumstances where VENTs are implied, not explicitly included in input file

   CALL DEFINE_IMPLICIT_VENTS

   ! Read the input file twice, first to count the VENTs, then to store the info in MESHES(NM)%VENTS(N)

   COUNT_OR_READ_LOOP: DO I_MODE=1,2

   ! Allocate the derived type variable VENTS that holds all vent info

   IF (I_MODE==2) ALLOCATE(MESHES(NM)%VENTS(N_VENT),STAT=IZERO) ; CALL ChkMemErr('READ','VENTS',IZERO) ; VENTS=>MESHES(NM)%VENTS

   ! Rewind the input file and read all possible vents

   N_VENT       = 0  ! Number of VENTs stored by each mesh
   N_TOTAL      = 0  ! Counter of all VENTs, both explicit and implicit
   N_EXPLICIT   = 0  ! Counter of explicitly declared VENTs
   N_VENT_TOTAL = 0  ! Purely for Smokeview drawing of VENTs

   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

   READ_VENT_LOOP: DO

      CALL SET_VENT_DEFAULTS

      N_TOTAL = N_TOTAL + 1

      ! Read the VENT lines that are explicitly listed in the input file, not the implicit MIRROR VENTs

      IF (N_TOTAL<=N_IMPLICIT_VENTS) THEN
         XB(1)      = IMPLICIT_VENT(N_TOTAL)%XB(1)
         XB(2)      = IMPLICIT_VENT(N_TOTAL)%XB(2)
         XB(3)      = IMPLICIT_VENT(N_TOTAL)%XB(3)
         XB(4)      = IMPLICIT_VENT(N_TOTAL)%XB(4)
         XB(5)      = IMPLICIT_VENT(N_TOTAL)%XB(5)
         XB(6)      = IMPLICIT_VENT(N_TOTAL)%XB(6)
         RGB(1)     = IMPLICIT_VENT(N_TOTAL)%RGB(1)
         RGB(2)     = IMPLICIT_VENT(N_TOTAL)%RGB(1)
         RGB(3)     = IMPLICIT_VENT(N_TOTAL)%RGB(1)
         MB         = IMPLICIT_VENT(N_TOTAL)%MB
         SURF_ID    = IMPLICIT_VENT(N_TOTAL)%SURF_ID
         ID         = IMPLICIT_VENT(N_TOTAL)%ID
         MESH_ID    = IMPLICIT_VENT(N_TOTAL)%MESH_ID
         EVACUATION = IMPLICIT_VENT(N_TOTAL)%EVACUATION
      ELSE
         CALL CHECKREAD('VENT',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
         IF (IOS==1) EXIT READ_VENT_LOOP
         N_EXPLICIT = N_EXPLICIT + 1
         READ(LU_INPUT,VENT,END=37,ERR=36,IOSTAT=IOS)    ! Read in info for VENT N
      36 IF (IOS>0) THEN
            WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with VENT number ',N_EXPLICIT,', line number ',INPUT_FILE_LINE_NUMBER
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         ENDIF
      ENDIF

      ! Simple error flagging

      IF (SURF_ID=='HVAC' .AND. MULT_ID/='null') THEN
         WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Cannot use MULT_ID with an HVAC VENT, VENT ',N_EXPLICIT,&
                                      ', line number ',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
      ENDIF
      IF (SURF_ID=='HVAC' .AND. ID=='null') THEN
         WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Specify an ID for an HVAC VENT, VENT ',N_EXPLICIT,&
                                      ', line number ',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
      ENDIF

      ! Special cases where VENT is specified with PBX, PBY, PBZ, MB, or DB

      IF (PBX>-1.E5_EB .OR. PBY>-1.E5_EB .OR. PBZ>-1.E5_EB) THEN
         IF (MULT_ID/='null') THEN
            WRITE(MESSAGE,'(A,I0,A)') 'ERROR: MULT_ID cannot be applied to VENT',N_EXPLICIT,' because it uses PBX, PBY or PBZ.'
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         ENDIF
         XB = (/XS,XF,YS,YF,ZS,ZF/)
         IF (PBX>-1.E5_EB) XB(1:2) = PBX
         IF (PBY>-1.E5_EB) XB(3:4) = PBY
         IF (PBZ>-1.E5_EB) XB(5:6) = PBZ
      ELSEIF (MB/='null') THEN
         IF (NMESHES>1 .AND. SURF_ID=='PERIODIC') THEN
            WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Use PBX,PBY,PBZ or XB for VENT',N_EXPLICIT,' multi-mesh PERIODIC boundary'
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         ENDIF
         IF (MULT_ID/='null') THEN
            WRITE(MESSAGE,'(A,I0,A)') 'ERROR: MULT_ID cannot be applied to VENT',N_EXPLICIT,' because it uses MB.'
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         ENDIF
         XB = (/XS,XF,YS,YF,ZS,ZF/)
         SELECT CASE (MB)
            CASE('XMIN') ; XB(2) = XS
            CASE('XMAX') ; XB(1) = XF
            CASE('YMIN') ; XB(4) = YS
            CASE('YMAX') ; XB(3) = YF
            CASE('ZMIN') ; XB(6) = ZS
            CASE('ZMAX') ; XB(5) = ZF
            CASE DEFAULT
               WRITE(MESSAGE,'(A,I0,A)') 'ERROR: MB specified for VENT',N_EXPLICIT,' is not XMIN, XMAX, YMIN, YMAX, ZMIN, or ZMAX'
               CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         END SELECT
      ELSEIF (DB/='null') THEN
         IF (MULT_ID/='null') THEN
            WRITE(MESSAGE,'(A,I0,A)') 'ERROR: MULT_ID cannot be applied to VENT',N_EXPLICIT,' because it uses DB.'
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         ENDIF
         XB = (/XS,XF,YS,YF,ZS,ZF/)
         SELECT CASE (DB)
            CASE('XMIN') ; XB(1:2) = XS_MIN+TWO_EPSILON_EB
            CASE('XMAX') ; XB(1:2) = XF_MAX-TWO_EPSILON_EB
            CASE('YMIN') ; XB(3:4) = YS_MIN+TWO_EPSILON_EB
            CASE('YMAX') ; XB(3:4) = YF_MAX-TWO_EPSILON_EB
            CASE('ZMIN') ; XB(5:6) = ZS_MIN+TWO_EPSILON_EB
            CASE('ZMAX') ; XB(5:6) = ZF_MAX-TWO_EPSILON_EB
            CASE DEFAULT
               WRITE(MESSAGE,'(A,I0,A)') 'ERROR: DB specified for VENT',N_EXPLICIT,' is not XMIN, XMAX, YMIN, YMAX, ZMIN, or ZMAX'
               CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         END SELECT
      ENDIF

      ! Check that the vent is properly specified

      IF (ABS(XB(3)-XB(4))<=SPACING(XB(4))  .AND. TWO_D .AND. N_TOTAL>N_IMPLICIT_VENTS) THEN
         IF (ID=='null')WRITE(MESSAGE,'(A,I0,A)')'ERROR: VENT ',N_EXPLICIT,' cannot be specified on a y boundary in a 2D calc'
         IF (ID/='null')WRITE(MESSAGE,'(A,A,A)') 'ERROR: VENT ',TRIM(ID),  ' cannot be specified on a y boundary in a 2D calc'
         CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
      ENDIF

      IF (ABS(XB(1)-XB(2))>SPACING(XB(2))  .AND. ABS(XB(3)-XB(4))>SPACING(XB(4))  .AND.ABS(XB(5)-XB(6))>SPACING(XB(6)) ) THEN
         IF (ID=='null') WRITE(MESSAGE,'(A,I0,A)') 'ERROR: VENT ',N_EXPLICIT,' must be a plane'
         IF (ID/='null') WRITE(MESSAGE,'(A,A,A)')  'ERROR: VENT ',TRIM(ID),' must be a plane'
         CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
      ENDIF

      ! Check if the XB coords are in the proper order

      CALL CHECK_XB(XB)

      ! Loop over all possible multiples of the VENT and save the user-specified coords, XB_USER

      MR => MULTIPLIER(0)
      DO NNN=1,N_MULT
         IF (MULT_ID==MULTIPLIER(NNN)%ID) THEN
            MR => MULTIPLIER(NNN)
            EXIT
         ENDIF
         IF (MULT_ID/='null' .AND. NNN==N_MULT) THEN
            WRITE(MESSAGE,'(A,A,A,I0,A,I0)') 'ERROR: MULT_ID ', TRIM(MULT_ID),' not found for VENT ',N_EXPLICIT,&
                                             ', line number ',INPUT_FILE_LINE_NUMBER
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
         ENDIF
      ENDDO

      K_MULT_LOOP: DO KK=MR%K_LOWER,MR%K_UPPER
         J_MULT_LOOP: DO JJ=MR%J_LOWER,MR%J_UPPER
            I_MULT_LOOP: DO II=MR%I_LOWER,MR%I_UPPER

               IF (MR%SKIP(II,JJ,KK)) CYCLE I_MULT_LOOP

               REJECT_VENT = .FALSE.

               N_VENT_TOTAL = N_VENT_TOTAL + 1  ! Count all possible VENTs for use in Smokeview

               IF (.NOT.MR%SEQUENTIAL) THEN
                  XB_USER(1) = XB(1) + MR%DX0 + II*MR%DXB(1)
                  XB_USER(2) = XB(2) + MR%DX0 + II*MR%DXB(2)
                  XB_USER(3) = XB(3) + MR%DY0 + JJ*MR%DXB(3)
                  XB_USER(4) = XB(4) + MR%DY0 + JJ*MR%DXB(4)
                  XB_USER(5) = XB(5) + MR%DZ0 + KK*MR%DXB(5)
                  XB_USER(6) = XB(6) + MR%DZ0 + KK*MR%DXB(6)
               ELSE
                  XB_USER(1) = XB(1) + MR%DX0 + II*MR%DXB(1)
                  XB_USER(2) = XB(2) + MR%DX0 + II*MR%DXB(2)
                  XB_USER(3) = XB(3) + MR%DY0 + II*MR%DXB(3)
                  XB_USER(4) = XB(4) + MR%DY0 + II*MR%DXB(4)
                  XB_USER(5) = XB(5) + MR%DZ0 + II*MR%DXB(5)
                  XB_USER(6) = XB(6) + MR%DZ0 + II*MR%DXB(6)
               ENDIF

               ! Save the VENT coordinates for the given MESH

               XB_MESH(1) = MAX(XB_USER(1),XS)
               XB_MESH(2) = MIN(XB_USER(2),XF)
               XB_MESH(3) = MAX(XB_USER(3),YS)
               XB_MESH(4) = MIN(XB_USER(4),YF)
               XB_MESH(5) = MAX(XB_USER(5),ZS)
               XB_MESH(6) = MIN(XB_USER(6),ZF)

               I1 = MAX(0,   NINT(GINV(XB_MESH(1)-XS,1,NM)*RDXI   ))
               I2 = MIN(IBAR,NINT(GINV(XB_MESH(2)-XS,1,NM)*RDXI   ))
               J1 = MAX(0,   NINT(GINV(XB_MESH(3)-YS,2,NM)*RDETA  ))
               J2 = MIN(JBAR,NINT(GINV(XB_MESH(4)-YS,2,NM)*RDETA  ))
               K1 = MAX(0,   NINT(GINV(XB_MESH(5)-ZS,3,NM)*RDZETA ))
               K2 = MIN(KBAR,NINT(GINV(XB_MESH(6)-ZS,3,NM)*RDZETA ))

               ! Decide if the VENT is inside or at the boundary of the current MESH

               IF ((XB_MESH(1)-XF)>SPACING(XF) .OR. (XS-XB_MESH(2))>SPACING(XS) .OR. &
                   (XB_MESH(3)-YF)>SPACING(YF) .OR. (YS-XB_MESH(4))>SPACING(YS) .OR. &
                   (XB_MESH(5)-ZF)>SPACING(ZF) .OR. (ZS-XB_MESH(6))>SPACING(ZS)) REJECT_VENT = .TRUE.

               ! Thicken evacuation mesh vents in the z direction

               IF (EVACUATION_ONLY(NM) .AND. EVACUATION .AND. K1==K2 .AND. .NOT.REJECT_VENT) THEN
                  K1 = INT(GINV(.5_EB*(XB_MESH(5)+XB_MESH(6))-ZS,3,NM)*RDZETA)
                  K2 = KBAR
                  XB_MESH(5) = ZS
                  XB_MESH(6) = ZF
                  IF (ABS(XB_MESH(1)-XB_MESH(2))>SPACING(XB_MESH(2)) .AND. ABS(XB_MESH(3)-XB_MESH(4))>SPACING(XB_MESH(4))) THEN
                     IF (ID=='null') WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Evacuation VENT ',N_TOTAL, ' must be a vertical plane'
                     IF (ID/='null') WRITE(MESSAGE,'(A,A,A)')  'ERROR: Evacuation VENT ',TRIM(ID),' must be a vertical plane'
                     CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                  ENDIF
               ENDIF

               IF (ABS(XB_MESH(1)-XB_MESH(2))<=SPACING(XB_MESH(2))) THEN
                  IF (J1==J2  .OR. K1==K2) REJECT_VENT=.TRUE.
                  IF (I1>IBAR .OR. I2<0)   REJECT_VENT=.TRUE.
               ENDIF
               IF (ABS(XB_MESH(3)-XB_MESH(4))<=SPACING(XB_MESH(4))) THEN
                  IF (I1==I2  .OR. K1==K2) REJECT_VENT=.TRUE.
                  IF (J1>JBAR .OR. J2<0)   REJECT_VENT=.TRUE.
               ENDIF
               IF (ABS(XB_MESH(5)-XB_MESH(6))<=SPACING(XB_MESH(6))) THEN
                  IF (I1==I2  .OR. J1==J2) REJECT_VENT=.TRUE.
                  IF (K1>KBAR .OR. K2<0)   REJECT_VENT=.TRUE.
               ENDIF

               ! Evacuation criteria

               IF (.NOT.EVACUATION .AND. EVACUATION_ONLY(NM)) REJECT_VENT=.TRUE.
               IF (EVACUATION .AND. .NOT.EVACUATION_ONLY(NM)) REJECT_VENT=.TRUE.

               ! Don't use this VENT if it is specified for another MESH

               IF (MESH_ID/='null' .AND. MESH_ID/=MESH_NAME(NM)) REJECT_VENT=.TRUE.

               ! If the VENT is rejected, cycle

               IF (REJECT_VENT) THEN
                  CYCLE I_MULT_LOOP
               ELSE
                  N_VENT = N_VENT + 1
                  IF (I_MODE==1) CYCLE I_MULT_LOOP
               ENDIF

               ! The VENT is accepted, add an entry to MESHES(NM)%VENTS

               VT=>VENTS(N_VENT)

               ! Set basic VENT coordinates

               VT%I1 = I1
               VT%I2 = I2
               VT%J1 = J1
               VT%J2 = J2
               VT%K1 = K1
               VT%K2 = K2

               VT%X1 = XB_MESH(1)
               VT%X2 = XB_MESH(2)
               VT%Y1 = XB_MESH(3)
               VT%Y2 = XB_MESH(4)
               VT%Z1 = XB_MESH(5)
               VT%Z2 = XB_MESH(6)

               VT%X1_ORIG = XB_USER(1)
               VT%X2_ORIG = XB_USER(2)
               VT%Y1_ORIG = XB_USER(3)
               VT%Y2_ORIG = XB_USER(4)
               VT%Z1_ORIG = XB_USER(5)
               VT%Z2_ORIG = XB_USER(6)

               ! Vent area

               IF (ABS(XB_USER(1)-XB_USER(2))<=SPACING(XB_USER(2))) &
                  VT%UNDIVIDED_INPUT_AREA = (XB_USER(4)-XB_USER(3))*(XB_USER(6)-XB_USER(5))
               IF (ABS(XB_USER(3)-XB_USER(4))<=SPACING(XB_USER(4))) &
                  VT%UNDIVIDED_INPUT_AREA = (XB_USER(2)-XB_USER(1))*(XB_USER(6)-XB_USER(5))
               IF (ABS(XB_USER(5)-XB_USER(6))<=SPACING(XB_USER(6))) &
                  VT%UNDIVIDED_INPUT_AREA = (XB_USER(2)-XB_USER(1))*(XB_USER(4)-XB_USER(3))

               IF (RADIUS>0._EB) VT%UNDIVIDED_INPUT_AREA = PI*RADIUS**2

               IF (ABS(VT%X2-VT%X1)<=SPACING(VT%X2) ) VT%INPUT_AREA = (VT%Y2-VT%Y1)*(VT%Z2-VT%Z1)
               IF (ABS(VT%Y2-VT%Y1)<=SPACING(VT%Y2) ) VT%INPUT_AREA = (VT%X2-VT%X1)*(VT%Z2-VT%Z1)
               IF (ABS(VT%Z2-VT%Z1)<=SPACING(VT%Z2) ) VT%INPUT_AREA = (VT%X2-VT%X1)*(VT%Y2-VT%Y1)

               ! Check the SURF_ID against the list of SURF's

               CALL CHECK_SURF_NAME(SURF_ID,EX)
               IF (.NOT.EX) THEN
                  WRITE(MESSAGE,'(A,A,A,I0,A,I0)') 'ERROR: SURF_ID ',TRIM(SURF_ID),' not found for VENT ',N_EXPLICIT,&
                                                   ', line number ',INPUT_FILE_LINE_NUMBER
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF

               ! Assign SURF_INDEX, Index of the Boundary Condition

               VT%SURF_INDEX = DEFAULT_SURF_INDEX
               DO NNN=0,N_SURF
                  IF (SURF_ID==SURFACE(NNN)%ID) VT%SURF_INDEX = NNN
               ENDDO

               IF (SURF_ID=='OPEN')                            VT%TYPE_INDICATOR =  2
               IF (SURF_ID=='MIRROR' .OR. SURF_ID=='PERIODIC') VT%TYPE_INDICATOR = -2
               IF ((MB/='null' .OR.  PBX>-1.E5_EB .OR. PBY>-1.E5_EB .OR. PBZ>-1.E5_EB) .AND. SURF_ID=='OPEN') VT%TYPE_INDICATOR=-2
               IF (SURF_ID=='PERIODIC FLOW ONLY') VT%SURF_INDEX = PERIODIC_FLOW_ONLY_SURF_INDEX

               VT%BOUNDARY_TYPE = SOLID_BOUNDARY
               IF (VT%SURF_INDEX==OPEN_SURF_INDEX)               VT%BOUNDARY_TYPE = OPEN_BOUNDARY
               IF (VT%SURF_INDEX==MIRROR_SURF_INDEX)             VT%BOUNDARY_TYPE = MIRROR_BOUNDARY
               IF (VT%SURF_INDEX==PERIODIC_SURF_INDEX)           VT%BOUNDARY_TYPE = PERIODIC_BOUNDARY
               IF (VT%SURF_INDEX==PERIODIC_FLOW_ONLY_SURF_INDEX) VT%BOUNDARY_TYPE = PERIODIC_BOUNDARY
               IF (VT%SURF_INDEX==HVAC_SURF_INDEX)               VT%BOUNDARY_TYPE = HVAC_BOUNDARY

               VT%IOR = IOR
               VT%ORDINAL = N_EXPLICIT

               ! Activate and Deactivate logic

               IF (ALL(EVACUATION_ONLY)) THEN
                  DEVC_ID = 'null'
                  CTRL_ID = 'null'
               ENDIF

               VT%ACTIVATED = .TRUE.
               VT%DEVC_ID   = DEVC_ID
               VT%CTRL_ID   = CTRL_ID
               VT%ID        = ID
               CALL SEARCH_CONTROLLER('VENT',CTRL_ID,DEVC_ID,VT%DEVC_INDEX,VT%CTRL_INDEX,N_VENT)
               IF (DEVC_ID /= 'null') THEN
                  IF (.NOT.DEVICE(VT%DEVC_INDEX)%INITIAL_STATE) VT%ACTIVATED = .FALSE.
               ENDIF
               IF (CTRL_ID /= 'null') THEN
                  IF (.NOT.CONTROL(VT%CTRL_INDEX)%INITIAL_STATE) VT%ACTIVATED = .FALSE.
               ENDIF

               IF ( (VT%BOUNDARY_TYPE==OPEN_BOUNDARY .OR. VT%BOUNDARY_TYPE==MIRROR_BOUNDARY .OR. &
                     VT%BOUNDARY_TYPE==PERIODIC_BOUNDARY) .AND. &
                     (VT%DEVC_ID /= 'null' .OR. VT%CTRL_ID /= 'null') ) THEN
                  IF (ID=='null') WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: VENT ',N_EXPLICIT, &
                     ' cannot be controlled by a device, line number ',INPUT_FILE_LINE_NUMBER
                  IF (ID/='null') WRITE(MESSAGE,'(A,A,A)')  'ERROR: VENT ',TRIM(ID),' cannot be controlled by a device'
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF

               ! Set the VENT color index

               SELECT CASE(COLOR)
                  CASE('INVISIBLE')
                     VT%COLOR_INDICATOR = 8
                     TRANSPARENCY = 0._EB
                  CASE('null')
                     VT%COLOR_INDICATOR = 99
                  CASE DEFAULT
                     VT%COLOR_INDICATOR = 99
                     CALL COLOR2RGB(RGB,COLOR)
               END SELECT
               IF (VT%COLOR_INDICATOR==8) VT%TYPE_INDICATOR = -2
               IF (OUTLINE)               VT%TYPE_INDICATOR =  2
               VT%RGB = RGB
               VT%TRANSPARENCY = TRANSPARENCY

               ! Parameters for specified spread of a fire over a VENT

               IF (ALL(XYZ<-1.E5_EB) .AND. SPREAD_RATE>0._EB) THEN
                  XYZ(1)=0.5_EB*(VT%X1+VT%X2)
                  XYZ(2)=0.5_EB*(VT%Y1+VT%Y2)
                  XYZ(3)=0.5_EB*(VT%Z1+VT%Z2)
               ENDIF
               VT%X0 = XYZ(1)
               VT%Y0 = XYZ(2)
               VT%Z0 = XYZ(3)
               VT%FIRE_SPREAD_RATE = SPREAD_RATE / TIME_SHRINK_FACTOR

               ! Circular VENT

               IF (RADIUS>0._EB) THEN
                  IF (ANY(XYZ<-1.E5_EB)) THEN
                     WRITE(MESSAGE,'(A,I0,A)') 'ERROR: VENT ',N_EXPLICIT,' requires center point XYZ'
                     CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                  ENDIF
                  VT%RADIUS = RADIUS
               ENDIF

               ! Dynamic Pressure

               VT%DYNAMIC_PRESSURE = DYNAMIC_PRESSURE
               IF (PRESSURE_RAMP/='null') CALL GET_RAMP_INDEX(PRESSURE_RAMP,'TIME',VT%PRESSURE_RAMP_INDEX)

               ! Synthetic Eddy Method

               VT%N_EDDY = N_EDDY
               IF (L_EDDY>TWO_EPSILON_EB) THEN
                  VT%SIGMA_IJ = L_EDDY
               ELSE
                  VT%SIGMA_IJ = L_EDDY_IJ ! Modified SEM (Jarrin, Ch. 7)
                  VT%SIGMA_IJ = MAX(VT%SIGMA_IJ,1.E-10_EB)
               ENDIF
               IF (VEL_RMS>0._EB) THEN
                  VT%R_IJ=0._EB
                  VT%R_IJ(1,1)=VEL_RMS**2
                  VT%R_IJ(2,2)=VEL_RMS**2
                  VT%R_IJ(3,3)=VEL_RMS**2
               ELSE
                  VT%R_IJ = REYNOLDS_STRESS
                  VT%R_IJ = MAX(VT%R_IJ,1.E-10_EB)
               ENDIF

               ! Check SEM parameters

               IF (N_EDDY>0) THEN
                  SYNTHETIC_EDDY_METHOD = .TRUE.
                  IF (ANY(VT%SIGMA_IJ<TWO_EPSILON_EB)) THEN
                     WRITE(MESSAGE,'(A,I0,A)') 'ERROR: VENT ',N_EXPLICIT,' L_EDDY = 0 in Synthetic Eddy Method'
                     CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                  ENDIF
                  IF (ALL(ABS(VT%R_IJ)<TWO_EPSILON_EB)) THEN
                     WRITE(MESSAGE,'(A,I0,A)') 'ERROR: VENT ',N_EXPLICIT,' VEL_RMS = 0 in Synthetic Eddy Method'
                     CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                  ENDIF
                  IF (TRIM(SURF_ID)=='HVAC') THEN
                     WRITE(MESSAGE,'(A,I0,A)') 'ERROR: VENT ',N_EXPLICIT,' Synthetic Eddy Method not permitted with HVAC'
                     CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
                  ENDIF
               ENDIF

               ! Check if the VENT is attached to a specific OBST

               IF (OBST_ID/='null') THEN
                  DO OBST_INDEX=1,N_OBST
                     IF (OBST_ID==OBSTRUCTION(OBST_INDEX)%ID) VT%OBST_INDEX = OBST_INDEX
                  ENDDO
               ENDIF

               ! Miscellaneous

               VT%TMP_EXTERIOR = TMP_EXTERIOR + TMPM
               IF (VT%TMP_EXTERIOR>0._EB) TMPMIN = MIN(TMPMIN,VT%TMP_EXTERIOR)
               IF (TMP_EXTERIOR_RAMP/='null') CALL GET_RAMP_INDEX(TMP_EXTERIOR_RAMP,'TIME',VT%TMP_EXTERIOR_RAMP_INDEX)

               VT%TEXTURE(:) = TEXTURE_ORIGIN(:)

               VT%UVW = UVW
               IF (ALL(VT%UVW > -1.E12_EB)) THEN
                  VT%UVW = VT%UVW/SQRT(VT%UVW(1)**2+VT%UVW(2)**2+VT%UVW(3)**2)
               ENDIF

               VT%GEOM = GEOM

            ENDDO I_MULT_LOOP
         ENDDO J_MULT_LOOP
      ENDDO K_MULT_LOOP

   ENDDO READ_VENT_LOOP

   ENDDO COUNT_OR_READ_LOOP

37 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

ENDDO MESH_LOOP_1

! Go through all the meshes again, but this time only if PROCESS(NM)==MYID

MESH_LOOP_2: DO NM=1,NMESHES

   IF (PROCESS(NM)/=MYID) CYCLE MESH_LOOP_2

   CALL POINT_TO_MESH(NM)

   ! Check vents and assign orientations

   VENT_LOOP_2: DO N=1,N_VENT

      VT => VENTS(N)

      I1 = MAX(0,VT%I1)
      I2 = MIN(IBAR,VT%I2)
      J1 = MAX(0,VT%J1)
      J2 = MIN(JBAR,VT%J2)
      K1 = MAX(0,VT%K1)
      K2 = MIN(KBAR,VT%K2)

      IF (VT%IOR==0) THEN
         IF (I1==      0 .AND. I2==0) VT%IOR =  1
         IF (I1==IBAR .AND. I2==IBAR) VT%IOR = -1
         IF (J1==      0 .AND. J2==0) VT%IOR =  2
         IF (J1==JBAR .AND. J2==JBAR) VT%IOR = -2
         IF (K1==      0 .AND. K2==0) VT%IOR =  3
         IF (K1==KBAR .AND. K2==KBAR) VT%IOR = -3
      ENDIF

      ORIENTATION_IF: IF (VT%IOR==0) THEN
         IF (I1==I2) THEN
            DO K=K1+1,K2
               DO J=J1+1,J2
                  IF (.NOT.SOLID(CELL_INDEX(I2+1,J,K))) VT%IOR =  1
                  IF (.NOT.SOLID(CELL_INDEX(I2  ,J,K))) VT%IOR = -1
               ENDDO
            ENDDO
         ENDIF
         IF (J1==J2) THEN
            DO K=K1+1,K2
               DO I=I1+1,I2
                  IF (.NOT.SOLID(CELL_INDEX(I,J2+1,K))) VT%IOR =  2
                  IF (.NOT.SOLID(CELL_INDEX(I,J2  ,K))) VT%IOR = -2
               ENDDO
            ENDDO
         ENDIF
         IF (K1==K2) THEN
            DO J=J1+1,J2
               DO I=I1+1,I2
                  IF (.NOT.SOLID(CELL_INDEX(I,J,K2+1))) VT%IOR =  3
                  IF (.NOT.SOLID(CELL_INDEX(I,J,K2  ))) VT%IOR = -3
               ENDDO
            ENDDO
         ENDIF
      ENDIF ORIENTATION_IF

      IF (VT%IOR==0) THEN
         WRITE(MESSAGE,'(A,I0,A,I0)')  'ERROR: Specify orientation of VENT ',VT%ORDINAL, ', MESH NUMBER',NM
         CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
      ENDIF

      ! Assign global periodicity

      IF (ABS(VT%IOR)==1 .AND. VT%SURF_INDEX==PERIODIC_SURF_INDEX) PERIODIC_DOMAIN_X = .TRUE.
      IF (ABS(VT%IOR)==2 .AND. VT%SURF_INDEX==PERIODIC_SURF_INDEX) PERIODIC_DOMAIN_Y = .TRUE.
      IF (ABS(VT%IOR)==3 .AND. VT%SURF_INDEX==PERIODIC_SURF_INDEX) PERIODIC_DOMAIN_Z = .TRUE.

      ! Other error messages for VENTs

      SELECT CASE(ABS(VT%IOR))
         CASE(1)
            IF (I1>=1 .AND. I1<=IBM1) THEN
               IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY.OR.VT%BOUNDARY_TYPE==MIRROR_BOUNDARY.OR.VT%BOUNDARY_TYPE==PERIODIC_BOUNDARY) THEN
                  WRITE(MESSAGE,'(A,I0,A)')  'ERROR: OPEN, MIRROR, OR PERIODIC VENT ',VT%ORDINAL, ' must be an exterior boundary.'
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF
               IF (VT%BOUNDARY_TYPE/=HVAC_BOUNDARY) VT%BOUNDARY_TYPE = SOLID_BOUNDARY
               IF (.NOT.SOLID(CELL_INDEX(I2+1,J2,K2)) .AND.  .NOT.SOLID(CELL_INDEX(I2,J2,K2))) THEN
                  WRITE(MESSAGE,'(A,I0,A)')  'ERROR: VENT ',VT%ORDINAL, ' must be attached to a solid obstruction'
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF
            ENDIF
         CASE(2)
            IF (J1>=1 .AND. J1<=JBM1) THEN
               IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY.OR.VT%BOUNDARY_TYPE==MIRROR_BOUNDARY.OR.VT%BOUNDARY_TYPE==PERIODIC_BOUNDARY) THEN
                  WRITE(MESSAGE,'(A,I0,A)')  'ERROR: OPEN, MIRROR, OR PERIODIC VENT ',VT%ORDINAL, ' must be an exterior boundary.'
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF
               IF (VT%BOUNDARY_TYPE/=HVAC_BOUNDARY) VT%BOUNDARY_TYPE = SOLID_BOUNDARY
               IF (.NOT.SOLID(CELL_INDEX(I2,J2+1,K2)) .AND.  .NOT.SOLID(CELL_INDEX(I2,J2,K2))) THEN
                  WRITE(MESSAGE,'(A,I0,A)')  'ERROR: VENT ',VT%ORDINAL, ' must be attached to a solid obstruction'
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF
            ENDIF
         CASE(3)
            IF (K1>=1 .AND. K1<=KBM1) THEN
               IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY.OR.VT%BOUNDARY_TYPE==MIRROR_BOUNDARY.OR.VT%BOUNDARY_TYPE==PERIODIC_BOUNDARY) THEN
                  WRITE(MESSAGE,'(A,I0,A)')  'ERROR: OPEN, MIRROR, OR PERIODIC VENT ',VT%ORDINAL, ' must be an exterior boundary.'
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF
               IF (VT%BOUNDARY_TYPE/=HVAC_BOUNDARY) VT%BOUNDARY_TYPE = SOLID_BOUNDARY
               IF (.NOT.SOLID(CELL_INDEX(I2,J2,K2+1)) .AND. .NOT.SOLID(CELL_INDEX(I2,J2,K2))) THEN
                  WRITE(MESSAGE,'(A,I0,A)')  'ERROR: VENT ',VT%ORDINAL, ' must be attached to a solid obstruction'
                  CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
               ENDIF
            ENDIF
      END SELECT

      ! Open up boundary cells if it is an open vent

      IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY) THEN
         SELECT CASE(VT%IOR)
            CASE( 1)
               CALL BLOCK_CELL(NM,   0,   0,J1+1,  J2,K1+1,  K2,0,0)
            CASE(-1)
               CALL BLOCK_CELL(NM,IBP1,IBP1,J1+1,  J2,K1+1,  K2,0,0)
            CASE( 2)
               CALL BLOCK_CELL(NM,I1+1,  I2,   0,   0,K1+1,  K2,0,0)
            CASE(-2)
               CALL BLOCK_CELL(NM,I1+1,  I2,JBP1,JBP1,K1+1,  K2,0,0)
            CASE( 3)
               CALL BLOCK_CELL(NM,I1+1,  I2,J1+1,  J2,   0,   0,0,0)
            CASE(-3)
               CALL BLOCK_CELL(NM,I1+1,  I2,J1+1,  J2,KBP1,KBP1,0,0)
         END SELECT
      ENDIF

      ! Check UVW

      IF (ABS(VT%UVW(ABS(VT%IOR))) < TWO_EPSILON_EB) THEN
         WRITE(MESSAGE,'(A,I0,A)')  'ERROR: VENT ',VT%ORDINAL, ' cannot have normal component of UVW equal to 0'
         CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
      ENDIF

   ENDDO VENT_LOOP_2

   ! Compute vent areas and check for passive openings

   VENT_LOOP_3: DO N=1,N_VENT

      VT => VENTS(N)

      IF (VT%SURF_INDEX==HVAC_SURF_INDEX .AND. N>1) THEN
         DO NNN=1,N-1
            IF (TRIM(VT%ID)==TRIM(VENTS(NNN)%ID) .AND. VENTS(NNN)%SURF_INDEX==HVAC_SURF_INDEX) THEN
               WRITE(MESSAGE,'(A,A)')  'ERROR: Two HVAC VENTS have the same ID.  VENT ID: ',TRIM(VT%ID)
               CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
            ENDIF
         ENDDO
      ENDIF

      VT%FDS_AREA = 0._EB
      IF (VT%RADIUS>0._EB) VT%INPUT_AREA = 0._EB

      I1 = VT%I1
      I2 = VT%I2
      J1 = VT%J1
      J2 = VT%J2
      K1 = VT%K1
      K2 = VT%K2

      VT%GHOST_CELLS_ONLY = .TRUE.

      SELECT CASE(ABS(VT%IOR))
         CASE(1)
            DO K=K1+1,K2
               DO J=J1+1,J2
                  IF (J>=1 .AND. J<=JBAR .AND. K>=1 .AND. K<=KBAR) VT%GHOST_CELLS_ONLY = .FALSE.
                  IF ( VT%RADIUS>0._EB) THEN
                     VT%INPUT_AREA = VT%INPUT_AREA + CIRCLE_CELL_INTERSECTION_AREA(VT%Y0,VT%Z0,VT%RADIUS,Y(J-1),Y(J),Z(K-1),Z(K))
                     IF (((YC(J)-VT%Y0)**2+(ZC(K)-VT%Z0)**2)>VT%RADIUS**2) CYCLE
                  ENDIF
                  VT%FDS_AREA = VT%FDS_AREA + DY(J)*DZ(K)
               ENDDO
            ENDDO
         CASE(2)
            DO K=K1+1,K2
               DO I=I1+1,I2
                  IF (I>=1 .AND. I<=IBAR .AND. K>=1 .AND. K<=KBAR) VT%GHOST_CELLS_ONLY = .FALSE.
                  IF ( VT%RADIUS>0._EB) THEN
                     VT%INPUT_AREA = VT%INPUT_AREA + CIRCLE_CELL_INTERSECTION_AREA(VT%X0,VT%Z0,VT%RADIUS,X(I-1),X(I),Z(K-1),Z(K))
                     IF (((XC(I)-VT%X0)**2+(ZC(K)-VT%Z0)**2)>VT%RADIUS**2) CYCLE
                  ENDIF
                  VT%FDS_AREA = VT%FDS_AREA + DX(I)*DZ(K)
               ENDDO
            ENDDO
         CASE(3)
            DO J=J1+1,J2
               DO I=I1+1,I2
                  IF (I>=1 .AND. I<=IBAR .AND. J>=1 .AND. J<=JBAR) VT%GHOST_CELLS_ONLY = .FALSE.
                  IF ( VT%RADIUS>0._EB) THEN
                     VT%INPUT_AREA = VT%INPUT_AREA + CIRCLE_CELL_INTERSECTION_AREA(VT%X0,VT%Y0,VT%RADIUS,X(I-1),X(I),Y(J-1),Y(J))
                     IF (((XC(I)-VT%X0)**2+(YC(J)-VT%Y0)**2)>VT%RADIUS**2) CYCLE
                  ENDIF
                  VT%FDS_AREA = VT%FDS_AREA + DX(I)*DY(J)
               ENDDO
            ENDDO
      END SELECT

   ENDDO  VENT_LOOP_3

ENDDO MESH_LOOP_2

CONTAINS


SUBROUTINE SET_VENT_DEFAULTS

COLOR             = 'null'
CTRL_ID           = 'null'
DB                = 'null'
DEVC_ID           = 'null'
DYNAMIC_PRESSURE  = 0._EB
EVACUATION        = .FALSE.
GEOM              = .FALSE.
ID                = 'null'
IOR               = 0
L_EDDY            = 0._EB
L_EDDY_IJ         = 0._EB
MB                = 'null'
MESH_ID           = 'null'
MULT_ID           = 'null'
N_EDDY            = 0
OBST_ID           = 'null'
OUTLINE           = .FALSE.
PBX               = -1.E6_EB
PBY               = -1.E6_EB
PBZ               = -1.E6_EB
PRESSURE_RAMP     = 'null'
RADIUS            = -1._EB
REYNOLDS_STRESS   = 0._EB
RGB               = -1
SPREAD_RATE       = -1._EB
SURF_ID           = 'null'
TEXTURE_ORIGIN    = -999._EB
TMP_EXTERIOR      = -1000.
TMP_EXTERIOR_RAMP = 'null'
TRANSPARENCY      = 1._EB
UVW               = -1.E12_EB
VEL_RMS           = 0._EB
XYZ               = -1.E6_EB

END SUBROUTINE SET_VENT_DEFAULTS


!> \brief Define VENTs that the user has not explicitly defined

SUBROUTINE DEFINE_IMPLICIT_VENTS

USE EVAC, ONLY: N_DOORS, N_EXITS, N_CO_EXITS, EMESH_EXITS
INTEGER :: N, N_END

N_END = N_EXITS - N_CO_EXITS + N_DOORS

IF (ALLOCATED(IMPLICIT_VENT)) DEALLOCATE(IMPLICIT_VENT)

ALLOCATE(IMPLICIT_VENT(N_END+5))

N_IMPLICIT_VENTS = 0

! Evacuation VENTs (for the outflow vents) need: XB, EVACUATION, RGB, MESH_ID, SURF_ID, IOR

NEND_LOOP_2: DO N = 1, N_END
   IF (.NOT.EMESH_EXITS(N)%DEFINE_MESH) CYCLE NEND_LOOP_2
   IF (EMESH_EXITS(N)%IMESH==NM .OR. EMESH_EXITS(N)%MAINMESH==NM) THEN
      EMESH_EXITS(N)%I_VENT = N
      N_IMPLICIT_VENTS = N_IMPLICIT_VENTS + 1
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%EVACUATION = .TRUE.
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%SURF_ID    = 'EVACUATION_OUTFLOW'
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%MESH_ID    = TRIM(MESH_NAME(NM))
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%XB(1)      = EMESH_EXITS(N)%XB(1)
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%XB(2)      = EMESH_EXITS(N)%XB(2)
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%XB(3)      = EMESH_EXITS(N)%XB(3)
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%XB(4)      = EMESH_EXITS(N)%XB(4)
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%XB(5)      = EMESH_EXITS(N)%XB(5)
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%XB(6)      = EMESH_EXITS(N)%XB(6)
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%RGB(:)     = EMESH_EXITS(N)%RGB(:)
      IMPLICIT_VENT(N_IMPLICIT_VENTS)%ID         = TRIM('Event_' // TRIM(MESH_NAME(NM)))
   ENDIF
ENDDO NEND_LOOP_2

! For a 2-D simulation, add MIRROR VENTs to lower and upper y boundary

IF (TWO_D) THEN
   IMPLICIT_VENT(N_IMPLICIT_VENTS+1)%MB      = 'YMIN'
   IMPLICIT_VENT(N_IMPLICIT_VENTS+2)%MB      = 'YMAX'
   IMPLICIT_VENT(N_IMPLICIT_VENTS+1)%SURF_ID = 'MIRROR'
   IMPLICIT_VENT(N_IMPLICIT_VENTS+2)%SURF_ID = 'MIRROR'
   N_IMPLICIT_VENTS = N_IMPLICIT_VENTS + 2
ENDIF

! For a cylindrical geometry where r_min=0, set a MIRROR BC

IF (CYLINDRICAL .AND. XS<=TWO_EPSILON_EB) THEN
   IMPLICIT_VENT(N_IMPLICIT_VENTS+1)%MB      = 'XMIN'
   IMPLICIT_VENT(N_IMPLICIT_VENTS+1)%SURF_ID = 'MIRROR'
   N_IMPLICIT_VENTS = N_IMPLICIT_VENTS + 1
ENDIF

IF (EVACUATION_ONLY(NM)) THEN
   IMPLICIT_VENT(N_IMPLICIT_VENTS+1)%MB      = 'ZMIN'
   IMPLICIT_VENT(N_IMPLICIT_VENTS+2)%MB      = 'ZMAX'
   IMPLICIT_VENT(N_IMPLICIT_VENTS+1)%SURF_ID = 'MIRROR'
   IMPLICIT_VENT(N_IMPLICIT_VENTS+2)%SURF_ID = 'MIRROR'
   N_IMPLICIT_VENTS = N_IMPLICIT_VENTS + 2
ENDIF

END SUBROUTINE DEFINE_IMPLICIT_VENTS

END SUBROUTINE READ_VENT


!> \brief Read the INIT namelist lines

SUBROUTINE READ_INIT

USE PHYSICAL_FUNCTIONS, ONLY: GET_SPECIFIC_GAS_CONSTANT
USE COMP_FUNCTIONS, ONLY: GET_FILE_NUMBER
USE MATH_FUNCTIONS, ONLY: GET_RAMP_INDEX
USE DEVICE_VARIABLES, ONLY: DEVICE_TYPE,DEVICE,N_DEVC
REAL(EB) :: DIAMETER,TEMPERATURE,DENSITY,RR_SUM,ZZ_GET(1:N_TRACKED_SPECIES),MASS_PER_VOLUME,PACKING_RATIO, &
            MASS_PER_TIME,DT_INSERT,UVW(3),HRRPUV,XYZ(3),DX,DY,DZ,HEIGHT,RADIUS,MASS_FRACTION(MAX_SPECIES), &
            PARTICLE_WEIGHT_FACTOR,VOLUME_FRACTION(MAX_SPECIES),RADIATIVE_FRACTION,CROWN_BASE_HEIGHT,CROWN_BASE_WIDTH,TREE_HEIGHT
INTEGER  :: NM,N,NN,NNN,II,JJ,KK,NS,NS2,NS3,N_PARTICLES,N_INIT_NEW,N_INIT_READ,N_PARTICLES_PER_CELL
LOGICAL  :: CELL_CENTERED,UNIFORM
CHARACTER(LABEL_LENGTH) :: ID,CTRL_ID,DEVC_ID,PART_ID,SHAPE,MULT_ID,SPEC_ID(1:MAX_SPECIES),PATH_RAMP(3),RAMP_Q
TYPE(INITIALIZATION_TYPE), POINTER :: IN=>NULL()
TYPE(MULTIPLIER_TYPE), POINTER :: MR=>NULL()
TYPE(LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC=>NULL()
TYPE(DEVICE_TYPE), POINTER :: DV,DV2
NAMELIST /INIT/ CELL_CENTERED,CROWN_BASE_HEIGHT,CROWN_BASE_WIDTH,CTRL_ID,DB,DENSITY,DEVC_ID,DIAMETER,DT_INSERT,DX,DY,DZ,&
                HEIGHT,HRRPUV,ID,MASS_FRACTION,MASS_PER_TIME,MASS_PER_VOLUME,MULT_ID,N_PARTICLES,&
                N_PARTICLES_PER_CELL,PACKING_RATIO,PART_ID,PARTICLE_WEIGHT_FACTOR,PATH_RAMP,RADIATIVE_FRACTION,&
                RADIUS,RAMP_Q,SHAPE,SPEC_ID,TEMPERATURE,TREE_HEIGHT,UNIFORM,UVW,VOLUME_FRACTION,XB,XYZ
N_INIT = 0
N_INIT_READ = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

COUNT_LOOP: DO
   CALL CHECKREAD('INIT',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_LOOP
   MULT_ID = 'null'
   READ(LU_INPUT,NML=INIT,END=11,ERR=12,IOSTAT=IOS)
   N_INIT_READ = N_INIT_READ + 1
   12 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with INIT number ',N_INIT_READ+1,', line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   N_INIT_NEW = 0
   IF (MULT_ID=='null') THEN
      N_INIT_NEW = 1
   ELSE
      DO N=1,N_MULT
         MR => MULTIPLIER(N)
         IF (MULT_ID==MR%ID) N_INIT_NEW = MR%N_COPIES
      ENDDO
      IF (N_INIT_NEW==0) THEN
         WRITE(MESSAGE,'(A,A,A,I0)') 'ERROR: MULT line ',TRIM(MULT_ID),' not found on INIT line', N_INIT_READ
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF
   N_INIT = N_INIT + N_INIT_NEW
ENDDO COUNT_LOOP
11 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! Add reserved INIT lines

N_INIT = N_INIT + N_INIT_RESERVED

! If there are no INIT lines, return

IF (N_INIT==0) RETURN

ALLOCATE(INITIALIZATION(N_INIT),STAT=IZERO)
CALL ChkMemErr('READ','INITIALIZATION',IZERO)

DO NN=1,N_INIT
   ALLOCATE(INITIALIZATION(NN)%MASS_FRACTION(N_TRACKED_SPECIES),STAT=IZERO)
   CALL ChkMemErr('READ','INITIALIZATION',IZERO)
   INITIALIZATION(NN)%MASS_FRACTION=0._EB
ENDDO

NN = 0

INIT_LOOP: DO N=1,N_INIT_READ+N_INIT_RESERVED

   IF (N<=N_INIT_READ) THEN

      ! Read in the INIT lines

      CALL CHECKREAD('INIT',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT INIT_LOOP
      CALL SET_INIT_DEFAULTS
      READ(LU_INPUT,INIT)
      IF (ANY(MASS_FRACTION>=0._EB) .AND. ANY(VOLUME_FRACTION>=0._EB)) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: INIT line ', N, ". Do not specify both MASS_FRACTION and VOLUME_FRACTION."
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

   ELSE

      ! Use information from DEVC line to create an INIT line for 'RADIATIVE HEAT FLUX GAS' or 'ADIABATIC SURFACE TEMPERATURE GAS'

      CALL SET_INIT_DEFAULTS
      DV => DEVICE(INIT_RESERVED(N-N_INIT_READ)%DEVC_INDEX)  ! First device in the line of POINTS
      WRITE(PART_ID,'(A)') 'RESERVED TARGET PARTICLE'
      ID = DV%ID
      XYZ(1) = DV%X
      XYZ(2) = DV%Y
      XYZ(3) = DV%Z
      IF (DV%LINE==0) THEN
         N_PARTICLES = 1
      ELSE
         N_PARTICLES = INIT_RESERVED(N-N_INIT_READ)%N_PARTICLES
         DV2 => DEVICE(INIT_RESERVED(N-N_INIT_READ)%DEVC_INDEX+N_PARTICLES-1)  ! Last device in the line of POINTS
         DX = (DV2%X-DV%X)/REAL(N_PARTICLES-1,EB)
         DY = (DV2%Y-DV%Y)/REAL(N_PARTICLES-1,EB)
         DZ = (DV2%Z-DV%Z)/REAL(N_PARTICLES-1,EB)
      ENDIF
   ENDIF

   ! Check if domain boundary has been set as the INIT volume

   IF (DB/='null') THEN
      ! any string will work, but suggest DB='WHOLE DOMAIN'
      XB(1) = XS_MIN
      XB(2) = XF_MAX
      XB(3) = YS_MIN
      XB(4) = YF_MAX
      XB(5) = ZS_MIN
      XB(6) = ZF_MAX
   ENDIF

   ! Transform XYZ into XB if necessary, and move XYZ points off of mesh boundaries.

   IF (ANY(XYZ>-100000._EB)) THEN

      MESH_LOOP: DO NM=1,NMESHES
         IF (EVACUATION_ONLY(NM)) CYCLE MESH_LOOP
         M=>MESHES(NM)
         IF (XYZ(1)>=M%XS .AND. XYZ(1)<=M%XF .AND. XYZ(2)>=M%YS .AND.  XYZ(2)<=M%YF .AND. XYZ(3)>=M%ZS .AND. XYZ(3)<=M%ZF) THEN
            IF (ABS(XYZ(1)-M%XS)<TWO_EPSILON_EB) XYZ(1) = XYZ(1) + 0.01_EB*M%DXI
            IF (ABS(XYZ(1)-M%XF)<TWO_EPSILON_EB) XYZ(1) = XYZ(1) - 0.01_EB*M%DXI
            IF (ABS(XYZ(2)-M%YS)<TWO_EPSILON_EB) XYZ(2) = XYZ(2) + 0.01_EB*M%DETA
            IF (ABS(XYZ(2)-M%YF)<TWO_EPSILON_EB) XYZ(2) = XYZ(2) - 0.01_EB*M%DETA
            IF (ABS(XYZ(3)-M%ZS)<TWO_EPSILON_EB) XYZ(3) = XYZ(3) + 0.01_EB*M%DZETA
            IF (ABS(XYZ(3)-M%ZF)<TWO_EPSILON_EB) XYZ(3) = XYZ(3) - 0.01_EB*M%DZETA
            EXIT MESH_LOOP
         ENDIF
      ENDDO MESH_LOOP

      XB(1:2) = XYZ(1)
      XB(3:4) = XYZ(2)
      XB(5:6) = XYZ(3)
   ENDIF

   ! If an offset has been specified, set the SHAPE to LINE.

   IF (DX>0._EB .OR. DY>0._EB .OR. DZ>0._EB) SHAPE = 'LINE'

   IF (N_PARTICLES>0 .AND. SHAPE=='LINE') THEN
      XB(2) = XB(1) + DX*(N_PARTICLES-1)
      XB(4) = XB(3) + DY*(N_PARTICLES-1)
      XB(6) = XB(5) + DZ*(N_PARTICLES-1)
   ENDIF

   ! Create a box around a CONE

   IF (SHAPE=='CONE' .OR. SHAPE=='RING') THEN
      XB(1) = XYZ(1) - RADIUS
      XB(2) = XYZ(1) + RADIUS
      XB(3) = XYZ(2) - RADIUS
      XB(4) = XYZ(2) + RADIUS
      XB(5) = XYZ(3)
      XB(6) = XYZ(3) + HEIGHT
      IF (SHAPE=='RING') XB(6) = XB(5)

      IF (CROWN_BASE_WIDTH > 0._EB) THEN !WFDS compatablitiy
        HEIGHT = XYZ(3) + TREE_HEIGHT
        RADIUS = 0.5_EB*CROWN_BASE_WIDTH
        XB(1) = XYZ(1) - RADIUS
        XB(2) = XYZ(1) + RADIUS
        XB(3) = XYZ(2) - RADIUS
        XB(4) = XYZ(2) + RADIUS
        XB(5) = XYZ(3) + CROWN_BASE_HEIGHT
        XB(6) = HEIGHT
      ENDIF

   ENDIF

   ! Reorder XB coordinates if necessary

   CALL CHECK_XB(XB)

   ! Loop over all possible multiples of the INIT

   MR => MULTIPLIER(0)
   DO NNN=1,N_MULT
      IF (MULT_ID==MULTIPLIER(NNN)%ID) MR => MULTIPLIER(NNN)
   ENDDO

   NNN = 0
   K_MULT_LOOP: DO KK=MR%K_LOWER,MR%K_UPPER
      J_MULT_LOOP: DO JJ=MR%J_LOWER,MR%J_UPPER
         I_MULT_LOOP: DO II=MR%I_LOWER,MR%I_UPPER

            IF (MR%SKIP(II,JJ,KK)) CYCLE I_MULT_LOOP

            NNN = NNN + 1  ! Counter for MULT INIT lines

            NN = NN + 1
            IN => INITIALIZATION(NN)

            ! Store the input parameters

            IF (.NOT.MR%SEQUENTIAL) THEN
               IN%X1 = XB(1) + MR%DX0 + II*MR%DXB(1)
               IN%X2 = XB(2) + MR%DX0 + II*MR%DXB(2)
               IN%Y1 = XB(3) + MR%DY0 + JJ*MR%DXB(3)
               IN%Y2 = XB(4) + MR%DY0 + JJ*MR%DXB(4)
               IN%Z1 = XB(5) + MR%DZ0 + KK*MR%DXB(5)
               IN%Z2 = XB(6) + MR%DZ0 + KK*MR%DXB(6)
            ELSE
               IN%X1 = XB(1) + MR%DX0 + II*MR%DXB(1)
               IN%X2 = XB(2) + MR%DX0 + II*MR%DXB(2)
               IN%Y1 = XB(3) + MR%DY0 + II*MR%DXB(3)
               IN%Y2 = XB(4) + MR%DY0 + II*MR%DXB(4)
               IN%Z1 = XB(5) + MR%DZ0 + II*MR%DXB(5)
               IN%Z2 = XB(6) + MR%DZ0 + II*MR%DXB(6)
            ENDIF

            IF (MR%N_COPIES>1) THEN
               WRITE(IN%ID,'(A,A,I5.5)') TRIM(ID),'-',NNN
            ELSE
               IN%ID = ID
            ENDIF

            IN%CELL_CENTERED = CELL_CENTERED
            IN%DIAMETER      = DIAMETER*1.E-6_EB
            IN%DX            = DX
            IN%DY            = DY
            IN%DZ            = DZ
            IN%CTRL_ID       = CTRL_ID
            IN%DEVC_ID       = DEVC_ID
            CALL SEARCH_CONTROLLER('INIT',IN%CTRL_ID,IN%DEVC_ID,IN%DEVC_INDEX,IN%CTRL_INDEX,N)
            IN%VOLUME        = (IN%X2-IN%X1)*(IN%Y2-IN%Y1)*(IN%Z2-IN%Z1)
            IN%TEMPERATURE   = TEMPERATURE + TMPM
            IN%DENSITY       = DENSITY
            IN%SHAPE         = SHAPE
            IN%HEIGHT        = HEIGHT
            IN%RADIUS        = RADIUS
            IN%HRRPUV        = HRRPUV*1000._EB
            IN%CHI_R         = RADIATIVE_FRACTION
            IF (HRRPUV > TWO_EPSILON_EB) INIT_HRRPUV = .TRUE.
            IF (RAMP_Q/='null') CALL GET_RAMP_INDEX(RAMP_Q,'TIME',IN%RAMP_Q_INDEX)
            IN%PACKING_RATIO = PACKING_RATIO
            IF (DENSITY > 0._EB) RHOMAX = MAX(RHOMAX,IN%DENSITY)

            SPEC_INIT_IF: IF (ANY(MASS_FRACTION>=0._EB)) THEN

               IF (SPEC_ID(1)=='null') THEN
                  WRITE(MESSAGE,'(A,I0,A,A)') 'ERROR: Problem with INIT number ',N,'. SPEC_ID must be used with MASS_FRACTION'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               DO NS=1,MAX_SPECIES
                  IF (SPEC_ID(NS)=='null') EXIT
                  DO NS2=1,N_TRACKED_SPECIES
                     IF (TRIM(SPEC_ID(NS))==TRIM(SPECIES_MIXTURE(NS2)%ID)) THEN
                        IN%MASS_FRACTION(NS2) = MASS_FRACTION(NS)
                        EXIT
                     ENDIF
                     IF (NS2==N_TRACKED_SPECIES)  THEN
                        WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Problem with INIT number ',N,' tracked species ',&
                           TRIM(SPEC_ID(NS)),' not found'
                           CALL SHUTDOWN(MESSAGE) ; RETURN
                     ENDIF
                  ENDDO
               ENDDO

               IF (SUM(IN%MASS_FRACTION) > 1._EB) THEN
                  WRITE(MESSAGE,'(A,I0,A,A)') 'ERROR: Problem with INIT number ',N,'. Sum of specified mass fractions > 1'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               IF (IN%MASS_FRACTION(1)<=TWO_EPSILON_EB) THEN
                  IN%MASS_FRACTION(1) = 1._EB - SUM(IN%MASS_FRACTION(2:N_TRACKED_SPECIES))
               ELSE
                  WRITE(MESSAGE,'(A,I0,A,A)') 'ERROR: Problem with INIT number ',N,&
                                                '. Cannot specify background species for MASS_FRACTION'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               ZZ_GET(1:N_TRACKED_SPECIES) = IN%MASS_FRACTION(1:N_TRACKED_SPECIES)
               CALL GET_SPECIFIC_GAS_CONSTANT(ZZ_GET,RR_SUM)

            ELSEIF (ANY(VOLUME_FRACTION>=0._EB)) THEN SPEC_INIT_IF
               MASS_FRACTION = 0._EB
               IF (SPEC_ID(1)=='null') THEN
                  WRITE(MESSAGE,'(A,I0,A,A)') 'ERROR: Problem with INIT number ',N,'. SPEC_ID must be used with VOLUME_FRACTION'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               NS3 = MAX_SPECIES
               DO NS=1,MAX_SPECIES
                  IF (SPEC_ID(NS)=='null') THEN
                     VOLUME_FRACTION(NS) = 0._EB
                     NS3 = MIN(MAX_SPECIES,NS-1)
                     EXIT
                  ENDIF
                  DO NS2=1,N_TRACKED_SPECIES
                     IF (TRIM(SPEC_ID(NS))==TRIM(SPECIES_MIXTURE(NS2)%ID)) THEN
                        MASS_FRACTION(NS2) = VOLUME_FRACTION(NS)*SPECIES_MIXTURE(NS2)%MW
                        EXIT
                     ENDIF
                     IF (NS2==N_TRACKED_SPECIES)  THEN
                        WRITE(MESSAGE,'(A,I0,A,A,A)') 'ERROR: Problem with INIT number ',N,' tracked species ',&
                           TRIM(SPEC_ID(NS)),' not found'
                           CALL SHUTDOWN(MESSAGE) ; RETURN
                     ENDIF
                  ENDDO
               ENDDO

               IF (MASS_FRACTION(1)<=TWO_EPSILON_EB) THEN
                  MASS_FRACTION(1) = (1._EB - SUM(VOLUME_FRACTION(1:NS3)))*SPECIES_MIXTURE(1)%MW
               ELSE
                  WRITE(MESSAGE,'(A,I0,A,A)') 'ERROR: Problem with INIT number ',N,&
                                                '. Cannot specify background species for VOLUME_FRACTION'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               IN%MASS_FRACTION(1:N_TRACKED_SPECIES) = MASS_FRACTION(1:N_TRACKED_SPECIES)/SUM(MASS_FRACTION(1:N_TRACKED_SPECIES))
               ZZ_GET(1:N_TRACKED_SPECIES) = IN%MASS_FRACTION(1:N_TRACKED_SPECIES)
               CALL GET_SPECIFIC_GAS_CONSTANT(ZZ_GET,RR_SUM)

            ELSE SPEC_INIT_IF

               IN%MASS_FRACTION(1:N_TRACKED_SPECIES) = SPECIES_MIXTURE(1:N_TRACKED_SPECIES)%ZZ0
               RR_SUM = RSUM0

            ENDIF SPEC_INIT_IF

            IF (TEMPERATURE > 0._EB) TMPMIN = MIN(TMPMIN,IN%TEMPERATURE)

            IF (IN%TEMPERATURE > 0._EB .AND. IN%DENSITY < 0._EB) THEN
               IN%DENSITY        = P_INF/(IN%TEMPERATURE*RR_SUM)
               IN%ADJUST_DENSITY = .TRUE.
            ENDIF
            IF (IN%TEMPERATURE < 0._EB .AND. IN%DENSITY > 0._EB) THEN
               IN%TEMPERATURE        = P_INF/(IN%DENSITY*RR_SUM)
               IN%ADJUST_TEMPERATURE = .TRUE.
            ENDIF
            IF (IN%TEMPERATURE < 0._EB .AND. IN%DENSITY < 0._EB) THEN
               IN%TEMPERATURE    = TMPA
               IN%DENSITY        = P_INF/(IN%TEMPERATURE*RR_SUM)
               IN%ADJUST_DENSITY = .TRUE.
            ENDIF

            ! Special case where INIT is used to introduce a block of particles

            IN%MASS_PER_TIME   = MASS_PER_TIME
            IN%MASS_PER_VOLUME = MASS_PER_VOLUME

            IF(N_PARTICLES_PER_CELL>0 .AND. N_PARTICLES>0) THEN
               WRITE(MESSAGE,'(A,I0,A)') 'ERROR: INIT ',N,' Cannot use both N_PARTICLES and N_PARTICLES_PER_CELL'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF

            IN%N_PARTICLES     = N_PARTICLES
            IN%N_PARTICLES_PER_CELL = N_PARTICLES_PER_CELL
            IN%PARTICLE_WEIGHT_FACTOR = PARTICLE_WEIGHT_FACTOR

            IF ( (IN%MASS_PER_VOLUME>0._EB.OR.PACKING_RATIO>0._EB) .AND. IN%VOLUME<=TWO_EPSILON_EB) THEN
               WRITE(MESSAGE,'(A,I0,A)') 'ERROR: INIT ',N,' XB has no volume'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF

            IN%DT_INSERT = DT_INSERT
            IF (DT_INSERT>0._EB) IN%SINGLE_INSERTION = .FALSE.

            ! Set up a clock to keep track of particle insertions

            ALLOCATE(IN%PARTICLE_INSERT_CLOCK(NMESHES),STAT=IZERO)
            CALL ChkMemErr('READ','PARTICLE_INSERT_CLOCK',IZERO)
            IN%PARTICLE_INSERT_CLOCK = T_BEGIN

            ALLOCATE(IN%ALREADY_INSERTED(NMESHES),STAT=IZERO)
            CALL ChkMemErr('READ','ALREADY_INSERTED',IZERO)
            IN%ALREADY_INSERTED = .FALSE.

            ! Assign an index to identify the particle class

            PART_ID_IF: IF (PART_ID/='null') THEN

               DO NS=1,N_LAGRANGIAN_CLASSES
                  IF (PART_ID==LAGRANGIAN_PARTICLE_CLASS(NS)%ID) THEN
                     IN%PART_INDEX = NS
                     PARTICLE_FILE = .TRUE.
                     EXIT
                  ENDIF
               ENDDO
               IF (IN%PART_INDEX<1) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: PART_ID ',TRIM(PART_ID),' does not exist'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               LPC => LAGRANGIAN_PARTICLE_CLASS(IN%PART_INDEX)
               IN%N_PARTICLES = N_PARTICLES*MAX(1,LPC%N_ORIENTATION)
               IN%N_PARTICLES_PER_CELL = N_PARTICLES_PER_CELL*MAX(1,LPC%N_ORIENTATION)

               ! Check for a particle path

               IF (TRIM(PATH_RAMP(1))/='null' .OR. TRIM(PATH_RAMP(2))/='null' .OR. TRIM(PATH_RAMP(3))/='null') THEN
                  IF (.NOT. N_PARTICLES == 1) THEN
                     WRITE(MESSAGE,'(A,I0,A,A)') 'ERROR: Problem with INIT number ',N, &
                        '. Must have N_PARTICLES=1 when specifying a PATH_RAMP.'
                     CALL SHUTDOWN(MESSAGE) ; RETURN
                  ENDIF
                  IF (TRIM(PATH_RAMP(1))/='null') THEN
                     CALL GET_RAMP_INDEX(PATH_RAMP(1),'TIME',IN%PATH_RAMP_INDEX(1))
                     IF (IN%PATH_RAMP_INDEX(1)==0) THEN
                        WRITE(MESSAGE,'(A,I0,A,A)') 'ERROR: Problem with INIT number ',N,'. PATH_RAMP(1) not found.'
                        CALL SHUTDOWN(MESSAGE) ; RETURN
                     ENDIF
                  ENDIF
                  IF (TRIM(PATH_RAMP(2))/='null') THEN
                     CALL GET_RAMP_INDEX(PATH_RAMP(2),'TIME',IN%PATH_RAMP_INDEX(2))
                     IF (IN%PATH_RAMP_INDEX(2)==0) THEN
                        WRITE(MESSAGE,'(A,I0,A,A)') 'ERROR: Problem with INIT number ',N,'. PATH_RAMP(2) not found.'
                        CALL SHUTDOWN(MESSAGE) ; RETURN
                     ENDIF
                  ENDIF
                  IF (TRIM(PATH_RAMP(3))/='null') THEN
                     CALL GET_RAMP_INDEX(PATH_RAMP(3),'TIME',IN%PATH_RAMP_INDEX(3))
                     IF (IN%PATH_RAMP_INDEX(3)==0) THEN
                        WRITE(MESSAGE,'(A,I0,A,A)') 'ERROR: Problem with INIT number ',N,'. PATH_RAMP(3) not found.'
                        CALL SHUTDOWN(MESSAGE) ; RETURN
                     ENDIF
                  ENDIF
               ENDIF

            ENDIF PART_ID_IF

            ! Random position is default, set to UNIFORM if desired

            IN%UNIFORM = UNIFORM

            ! Initial velocity components

            IN%U0 = UVW(1)
            IN%V0 = UVW(2)
            IN%W0 = UVW(3)

         ENDDO I_MULT_LOOP
      ENDDO J_MULT_LOOP
   ENDDO K_MULT_LOOP

ENDDO INIT_LOOP

! Check if there are any devices that refer to INIT lines

DEVICE_LOOP: DO NN=1,N_DEVC
   DV => DEVICE(NN)
   IF (DV%INIT_ID=='null') CYCLE
   DO I=1,N_INIT
      IN => INITIALIZATION(I)
      IF (IN%ID==DV%INIT_ID) THEN
         IF (ANY(IN%PATH_RAMP_INDEX > 0)) THEN
            IF (DV%SPATIAL_STATISTIC/='null') THEN
               WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' for INIT ', TRIM(IN%ID),&
                  ' cannot use a SPATIAL_STATISTIC.'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDIF
         CYCLE DEVICE_LOOP
      ENDIF
   ENDDO
   WRITE(MESSAGE,'(A,A,A)') 'ERROR: The INIT_ID for DEVC ',TRIM(DV%ID),' cannot be found.'
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDDO DEVICE_LOOP

! Rewind the input file and return

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

CONTAINS


!> \brief Set default values for the INIT namelist group

SUBROUTINE SET_INIT_DEFAULTS

CELL_CENTERED             = .FALSE.
CROWN_BASE_WIDTH          = -1._EB
CROWN_BASE_HEIGHT         = -1._EB
CTRL_ID                   = 'null'
DENSITY                   = -1000._EB
DEVC_ID                   = 'null'
DIAMETER                  = -1._EB
DT_INSERT                 = -1._EB
DX                        =  0._EB
DY                        =  0._EB
DZ                        =  0._EB
HEIGHT                    = -1._EB
HRRPUV                    =  0._EB
ID                        = 'null'
MASS_FRACTION             = -1._EB
MASS_PER_TIME             = -1._EB
MASS_PER_VOLUME           = -1._EB
PACKING_RATIO             = -1._EB
MULT_ID                   = 'null'
N_PARTICLES               = 0
N_PARTICLES_PER_CELL      = 0
PARTICLE_WEIGHT_FACTOR    = 1.0_EB
PART_ID                   = 'null'
PATH_RAMP                 = 'null'
RADIATIVE_FRACTION        = 0.0_EB
RADIUS                    = -1._EB
RAMP_Q                    = 'null'
SHAPE                     = 'BLOCK'
SPEC_ID                   = 'null'
TEMPERATURE               = -1000._EB
TREE_HEIGHT               = -1._EB
UNIFORM                   = .FALSE.
UVW                       = 0._EB
VOLUME_FRACTION           = -1._EB
DB                        = 'null'
XB(1)                     = -1000000._EB
XB(2)                     =  1000000._EB
XB(3)                     = -1000000._EB
XB(4)                     =  1000000._EB
XB(5)                     = -1000000._EB
XB(6)                     =  1000000._EB
XYZ                       = -1000000._EB

END SUBROUTINE SET_INIT_DEFAULTS

END SUBROUTINE READ_INIT


SUBROUTINE PROC_INIT

INTEGER :: NN
REAL(EB) :: DRY_DENSITY, MOIST_FRAC
TYPE (LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC => NULL()
TYPE (INITIALIZATION_TYPE), POINTER :: IN => NULL()

DO NN=1,N_INIT
   IN=>INITIALIZATION(NN)
   IF (IN%MASS_PER_TIME>0._EB .OR. IN%MASS_PER_VOLUME>0._EB .OR. IN%PACKING_RATIO>0._EB) THEN
      LPC => LAGRANGIAN_PARTICLE_CLASS(IN%PART_INDEX)
      IF (LPC%DENSITY < 0._EB) THEN
         WRITE(MESSAGE,'(A,A,A)') 'INIT ERROR: PARTicle class ',TRIM(LPC%ID),' requires a density'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (LPC%SURF_INDEX>0) THEN
         MOIST_FRAC = SURFACE(LPC%SURF_INDEX)%MOISTURE_FRACTION(1)
         IF (MOIST_FRAC>=0._EB) THEN
            IF (IN%PACKING_RATIO>0._EB) THEN
               DRY_DENSITY = 1._EB / ((1._EB+MOIST_FRAC)/LPC%DENSITY - MOIST_FRAC/1000._EB)
               IN%MASS_PER_VOLUME = DRY_DENSITY*IN%PACKING_RATIO  ! Dry mass per volume
            ENDIF
            IN%MASS_PER_TIME   = IN%MASS_PER_TIME  *(1._EB+MOIST_FRAC)
            IN%MASS_PER_VOLUME = IN%MASS_PER_VOLUME*(1._EB+MOIST_FRAC)
         ENDIF
      ENDIF
   ENDIF
ENDDO

END SUBROUTINE PROC_INIT


!> \brief Read the ZONE namelist lines

SUBROUTINE READ_ZONE

REAL(EB), ALLOCATABLE, DIMENSION(:) :: LEAK_AREA, LEAK_REFERENCE_PRESSURE, LEAK_PRESSURE_EXPONENT
REAL(EB) :: XYZ(3,N_ZONE_POINTS)
INTEGER  :: N,NM,NN
LOGICAL :: PERIODIC
CHARACTER(LABEL_LENGTH) :: ID
INTEGER, ALLOCATABLE, DIMENSION(:) :: COUNTS,DISPLS
NAMELIST /ZONE/ ID,LEAK_AREA,LEAK_PRESSURE_EXPONENT,LEAK_REFERENCE_PRESSURE,PERIODIC,XB,XYZ

ALLOCATE (LEAK_AREA(0:MAX_LEAK_PATHS))
ALLOCATE (LEAK_REFERENCE_PRESSURE(0:MAX_LEAK_PATHS))
ALLOCATE (LEAK_PRESSURE_EXPONENT(0:MAX_LEAK_PATHS))

! Count the ZONE lines

N_ZONE = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_ZONE_LOOP: DO
   CALL CHECKREAD('ZONE',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_ZONE_LOOP
   READ(LU_INPUT,NML=ZONE,END=11,ERR=12,IOSTAT=IOS)
   N_ZONE = N_ZONE + 1
   12 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with ZONE number ',N_ZONE+1,', line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
ENDDO COUNT_ZONE_LOOP
11 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! If all of the meshes are sealed and no ZONEs are declared, stop with an ERROR

ALLOCATE(COUNTS(0:N_MPI_PROCESSES-1)) ; COUNTS = 0
ALLOCATE(DISPLS(0:N_MPI_PROCESSES-1)) ; DISPLS = 0
DO N=0,N_MPI_PROCESSES-1
   DO NM=1,NMESHES
      IF (PROCESS(NM)==N) COUNTS(N) = COUNTS(N) + 1
   ENDDO
   IF (N>0) DISPLS(N) = COUNTS(N-1) + DISPLS(N-1)
ENDDO

! If there are no ZONE lines, return

IF (N_ZONE==0) RETURN

! Allocate ZONE arrays

ALLOCATE(P_ZONE(N_ZONE),STAT=IZERO)
CALL ChkMemErr('READ','P_ZONE',IZERO)

! Read in and process ZONE lines

READ_ZONE_LOOP: DO N=1,N_ZONE

   ALLOCATE(P_ZONE(N)%LEAK_AREA(0:N_ZONE),STAT=IZERO)
   CALL ChkMemErr('READ','LEAK_AREA',IZERO)
   ALLOCATE(P_ZONE(N)%LEAK_PRESSURE_EXPONENT(0:N_ZONE),STAT=IZERO)
   CALL ChkMemErr('READ','LEAK_PRESSURE_EXPONENT',IZERO)
   ALLOCATE(P_ZONE(N)%LEAK_REFERENCE_PRESSURE(0:N_ZONE),STAT=IZERO)
   CALL ChkMemErr('READ','LEAK_REFERENCE_PRESSURE',IZERO)

   ! Default ZONE parameters

   IF (N<1000) WRITE(ID,'(A,I3)') 'ZONE_',N
   IF (N<100)  WRITE(ID,'(A,I2)') 'ZONE_',N
   IF (N<10)   WRITE(ID,'(A,I1)') 'ZONE_',N
   LEAK_AREA     = 0._EB
   LEAK_REFERENCE_PRESSURE = 4._EB
   LEAK_PRESSURE_EXPONENT = 0.5_EB
   XB(1)         = -1000000._EB
   XB(2)         =  1000000._EB
   XB(3)         = -1000000._EB
   XB(4)         =  1000000._EB
   XB(5)         = -1000000._EB
   XB(6)         =  1000000._EB
   PERIODIC      = .FALSE.
   XYZ           = -1000000._EB

   ! Read the ZONE line(s)

   CALL CHECKREAD('ZONE',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_ZONE_LOOP
   READ(LU_INPUT,ZONE)

   ! Reorder XB coords if necessary

   CALL CHECK_XB(XB)

   ! Assign parameters to P_ZONE dervied type variable

   P_ZONE(N)%ID = ID
   P_ZONE(N)%EVACUATION = .FALSE.
   P_ZONE(N)%PERIODIC = PERIODIC

   IF (XYZ(1,1)>-999999._EB) THEN  ! Process the first XYZ point. The rest are ignored.
      P_ZONE(N)%X = XYZ(1,1)
      P_ZONE(N)%Y = XYZ(2,1)
      P_ZONE(N)%Z = XYZ(3,1)
   ELSEIF (XB(1)>-999999._EB) THEN  ! Process the (deprecated) XB input
      P_ZONE(N)%X = 0.5_EB*(XB(1)+XB(2))
      P_ZONE(N)%Y = 0.5_EB*(XB(3)+XB(4))
      P_ZONE(N)%Z = 0.5_EB*(XB(5)+XB(6))
   ELSE  ! Find the first non-solid cell in the first mesh controlled by this MPI process
      M => MESHES(LOWER_MESH_INDEX)
      K_LOOP: DO K=1,M%KBAR
         J_LOOP: DO J=1,M%JBAR
            I_LOOP: DO I=1,M%IBAR
               IF (M%SOLID(M%CELL_INDEX(I,J,K))) CYCLE I_LOOP
               P_ZONE(N)%X = M%XC(I)
               P_ZONE(N)%Y = M%YC(J)
               P_ZONE(N)%Z = M%ZC(K)
               EXIT K_LOOP
            ENDDO I_LOOP
         ENDDO J_LOOP
      ENDDO K_LOOP
   ENDIF

   ! Check the leakage paths and logic

   DO NN=0,N_ZONE
      P_ZONE(N)%LEAK_AREA(NN) = LEAK_AREA(NN)
      P_ZONE(N)%LEAK_REFERENCE_PRESSURE(NN) = LEAK_REFERENCE_PRESSURE(NN)
      P_ZONE(N)%LEAK_PRESSURE_EXPONENT(NN) = LEAK_PRESSURE_EXPONENT(NN)
   ENDDO

   IF (N > 1) THEN
      DO NN=1,N-1
         IF (P_ZONE(NN)%LEAK_AREA(N)>0._EB) THEN
            IF (P_ZONE(N)%LEAK_AREA(NN) > 0._EB) THEN
               WRITE(MESSAGE,'(A,I0,A,I0)')  'ERROR: LEAK_AREA specified twice for ZONE ',N,' and ',NN
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ELSE
               P_ZONE(N)%LEAK_AREA(NN)               = P_ZONE(NN)%LEAK_AREA(N)
               P_ZONE(N)%LEAK_REFERENCE_PRESSURE(NN) = P_ZONE(NN)%LEAK_REFERENCE_PRESSURE(N)
               P_ZONE(N)%LEAK_PRESSURE_EXPONENT(NN)  = P_ZONE(NN)%LEAK_PRESSURE_EXPONENT(N)
            ENDIF
         ENDIF
      ENDDO
   ENDIF

ENDDO READ_ZONE_LOOP

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

DEALLOCATE (LEAK_AREA)

END SUBROUTINE READ_ZONE


!> \brief Read the DEViCe namelist lines and the store the info in DEVICE()

SUBROUTINE READ_DEVC

USE DEVICE_VARIABLES, ONLY: DEVICE_TYPE,SUBDEVICE_TYPE,DEVICE,N_DEVC,N_DEVC_TIME,N_DEVC_LINE,MAX_DEVC_LINE_POINTS,&
                            DEVC_PIPE_OPERATING
USE GEOMETRY_FUNCTIONS, ONLY: TRANSFORM_COORDINATES
INTEGER  :: N,NN,NM,MESH_NUMBER=0,N_DEVC_READ,IOR,TRIP_DIRECTION,VELO_INDEX,POINTS,I_POINT,PIPE_INDEX,ORIENTATION_INDEX, &
            ORIENTATION_NUMBER,N_INTERVALS,MOVE_INDEX
REAL(EB) :: DEPTH,ORIENTATION(3),ROTATION,SETPOINT,FLOWRATE,BYPASS_FLOWRATE,DELAY,XYZ(3),CONVERSION_FACTOR,CONVERSION_ADDEND, &
            SMOOTHING_FACTOR,OR_TEMP(3),QUANTITY_RANGE(2),STATISTICS_START,STATISTICS_END,COORD_FACTOR,CELL_L,&
            TIME_PERIOD,FORCE_DIRECTION(3)
CHARACTER(LABEL_LENGTH) :: QUANTITY,QUANTITY2,PROP_ID,CTRL_ID,DEVC_ID,INIT_ID,SURF_ID,SPATIAL_STATISTIC,TEMPORAL_STATISTIC,&
                 MOVE_ID,STATISTICS,PART_ID,MATL_ID,SPEC_ID,UNITS, &
                 DUCT_ID,NODE_ID(2),D_ID,R_ID,X_ID,Y_ID,Z_ID,NO_UPDATE_DEVC_ID,NO_UPDATE_CTRL_ID,REAC_ID,XYZ_UNITS
LOGICAL :: INITIAL_STATE,LATCH,DRY,TIME_AVERAGED,EVACUATION,HIDE_COORDINATES,RELATIVE,OUTPUT,NEW_ORIENTATION_VECTOR,TIME_HISTORY,&
           LINE_DEVICE,ABSOLUTE_VALUE,OVERLAPPING_X,OVERLAPPING_Y,OVERLAPPING_Z
TYPE (DEVICE_TYPE), POINTER :: DV
TYPE (SUBDEVICE_TYPE), POINTER :: SDV
NAMELIST /DEVC/ ABSOLUTE_VALUE,BYPASS_FLOWRATE,CONVERSION_ADDEND,CONVERSION_FACTOR,COORD_FACTOR,CELL_L,CTRL_ID,DB,DELAY,DEPTH,&
                DEVC_ID,D_ID,DRY,DUCT_ID,EVACUATION,FLOWRATE,FORCE_DIRECTION,FYI,HIDE_COORDINATES,ID,&
                INITIAL_STATE,INIT_ID,IOR,LATCH,MATL_ID,MOVE_ID,N_INTERVALS,NODE_ID,NO_UPDATE_CTRL_ID,NO_UPDATE_DEVC_ID,&
                ORIENTATION,ORIENTATION_NUMBER,OUTPUT,PART_ID,PIPE_INDEX,&
                POINTS,PROP_ID,QUANTITY,QUANTITY2,QUANTITY_RANGE,REAC_ID,RELATIVE,R_ID,ROTATION,SETPOINT,SMOOTHING_FACTOR,&
                SPATIAL_STATISTIC,SPEC_ID,STATISTICS,STATISTICS_END,STATISTICS_START,SURF_ID,TEMPORAL_STATISTIC,&
                TIME_AVERAGED,TIME_HISTORY,TIME_PERIOD,TRIP_DIRECTION,UNITS,VELO_INDEX,XB,XYZ,X_ID,Y_ID,Z_ID,XYZ_UNITS
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: MESH_DEVICE_ARRAY
INTEGER, ALLOCATABLE, DIMENSION(:) :: MESH_DEVICE

! Read the input file and count the number of DEVC lines

N_DEVC = 0
N_DEVC_READ = 0
N_DEVC_TIME = 0
N_DEVC_LINE = 0

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_DEVC_LOOP: DO
   CALL CHECKREAD('DEVC',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_DEVC_LOOP
   POINTS = 1
   TIME_HISTORY = .FALSE.
   READ(LU_INPUT,NML=DEVC,END=11,ERR=12,IOSTAT=IOS)
   N_DEVC      = N_DEVC      + POINTS
   N_DEVC_READ = N_DEVC_READ + 1
   IF (POINTS>1 .AND. .NOT.TIME_HISTORY) MAX_DEVC_LINE_POINTS = MAX(MAX_DEVC_LINE_POINTS,POINTS)
   12 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with DEVC number ',N_DEVC_READ+1,', line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDDO COUNT_DEVC_LOOP
11 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (N_DEVC==0) RETURN

! Allocate DEVICE array to hold all information for each device

ALLOCATE(DEVICE(N_DEVC),STAT=IZERO) ; CALL ChkMemErr('READ','DEVICE',IZERO)

! Speceial case for QUANTITY='RADIATIVE HEAT FLUX GAS' or 'ADIABATIC SURFACE TEMPERATURE GAS'

ALLOCATE(INIT_RESERVED(N_DEVC),STAT=IZERO) ; CALL ChkMemErr('READ','INIT_RESERVED',IZERO)
N_INIT_RESERVED = 0

! Allocate temporary logical arrays to indicate if a given mesh holds a given device

ALLOCATE(MESH_DEVICE_ARRAY(NMESHES,N_DEVC)) ; MESH_DEVICE_ARRAY = 0
ALLOCATE(MESH_DEVICE(NMESHES))

! Read in the DEVC lines, keeping track of TIME-history devices, and LINE array devices

N_DEVC = 0

READ_DEVC_LOOP: DO NN=1,N_DEVC_READ

   CALL CHECKREAD('DEVC',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_DEVC_LOOP
   CALL SET_DEVC_DEFAULTS
   READ(LU_INPUT,DEVC)

   ! Special cases

   IF (QUANTITY=='TRANSMISSION') QUANTITY2 = 'PATHLENGTH'

   ! Check to see if a domain boundary has been set

   IF (DB/='null') THEN
      ! any string will work, but suggest DB='WHOLE DOMAIN'
      XB(1) = XS_MIN
      XB(2) = XF_MAX
      XB(3) = YS_MIN
      XB(4) = YF_MAX
      XB(5) = ZS_MIN
      XB(6) = ZF_MAX
   ENDIF

   ! Check the QUANTITY_RANGE

   IF (QUANTITY_RANGE(2) <= QUANTITY_RANGE(1)) THEN
      WRITE(MESSAGE,'(A,A,A)')  'ERROR: DEVC ',TRIM(ID),' has QUANTITY_RANGE(2) <= QUANTITY_RANGE(1)'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Transform coordinates if necessary

   MOVE_INDEX = 0
   IF (MOVE_ID/='null') THEN
      DO I=1,N_MOVE
         IF (MOVE_ID==MOVEMENT(I)%ID) THEN
            MOVE_INDEX = MOVEMENT(I)%INDEX
            EXIT
         ENDIF
      ENDDO
      IF (MOVE_INDEX==0) THEN
         WRITE(MESSAGE,'(A,A,A)')  'ERROR: DEVC ',TRIM(ID),' MOVE_ID is not recognized'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (XYZ(1)>-1.E5_EB) CALL TRANSFORM_COORDINATES(XYZ(1),XYZ(2),XYZ(3),MOVE_INDEX)
      IF (XB(1) >-1.E5_EB) CALL TRANSFORM_COORDINATES(XB(1),XB(3),XB(5),MOVE_INDEX)
      IF (XB(1) >-1.E5_EB) CALL TRANSFORM_COORDINATES(XB(2),XB(4),XB(6),MOVE_INDEX)
   ENDIF

   ! Assign STATISTICS to SPATIAL or TEMPORAL

   SELECT CASE(STATISTICS)

      CASE('null')
      CASE('INSTANT VALUE')   ; TEMPORAL_STATISTIC = 'INSTANT VALUE'
      CASE('TIME AVERAGE')    ; TEMPORAL_STATISTIC = 'TIME AVERAGE'
      CASE('RUNNING AVERAGE') ; TEMPORAL_STATISTIC = 'RUNNING AVERAGE'
      CASE('TIME INTEGRAL')   ; TEMPORAL_STATISTIC = 'TIME INTEGRAL'
      CASE('TIME MAX')        ; TEMPORAL_STATISTIC = 'MAX'
      CASE('TIME MIN')        ; TEMPORAL_STATISTIC = 'MIN'
      CASE('RMS')             ; TEMPORAL_STATISTIC = 'RMS'
      CASE('COV')             ; TEMPORAL_STATISTIC = 'COV'
      CASE('CORRCOEF')        ; TEMPORAL_STATISTIC = 'CORRCOEF'

      CASE('AREA')             ; SPATIAL_STATISTIC = 'AREA'
      CASE('AREA INTEGRAL')    ; SPATIAL_STATISTIC = 'AREA INTEGRAL'
      CASE('VOLUME INTEGRAL')  ; SPATIAL_STATISTIC = 'VOLUME INTEGRAL'
      CASE('VOLUME MEAN')      ; SPATIAL_STATISTIC = 'VOLUME MEAN'
      CASE('VOLUME')           ; SPATIAL_STATISTIC = 'VOLUME'
      CASE('SURFACE INTEGRAL') ; SPATIAL_STATISTIC = 'SURFACE INTEGRAL'
      CASE('SURFACE AREA')     ; SPATIAL_STATISTIC = 'SURFACE AREA'
      CASE('MASS INTEGRAL')    ; SPATIAL_STATISTIC = 'MASS INTEGRAL'
      CASE('MASS MEAN')        ; SPATIAL_STATISTIC = 'MASS MEAN'
      CASE('MASS')             ; SPATIAL_STATISTIC = 'MASS'
      CASE('MAX')              ; SPATIAL_STATISTIC = 'MAX'
      CASE('MAXLOC X')         ; SPATIAL_STATISTIC = 'MAXLOC X'
      CASE('MAXLOC Y')         ; SPATIAL_STATISTIC = 'MAXLOC Y'
      CASE('MAXLOC Z')         ; SPATIAL_STATISTIC = 'MAXLOC Z'
      CASE('MIN')              ; SPATIAL_STATISTIC = 'MIN'
      CASE('MINLOC X')         ; SPATIAL_STATISTIC = 'MINLOC X'
      CASE('MINLOC Y')         ; SPATIAL_STATISTIC = 'MINLOC Y'
      CASE('MINLOC Z')         ; SPATIAL_STATISTIC = 'MINLOC Z'
      CASE('MEAN')             ; SPATIAL_STATISTIC = 'MEAN'

      CASE DEFAULT
         WRITE(MESSAGE,'(A,A,A)')  'ERROR: DEVC ',TRIM(ID),' STATISTICS is not recognized'
         CALL SHUTDOWN(MESSAGE) ; RETURN

   END SELECT

   ! Backward compartibility

   IF (.NOT.TIME_AVERAGED) TEMPORAL_STATISTIC = 'INSTANT VALUE'

   ! Determine if the device is a steady-state "line" device or the usual time-history device.

   LINE_DEVICE = .FALSE.
   IF (POINTS>1 .AND. .NOT.TIME_HISTORY) THEN
      LINE_DEVICE = .TRUE.
      IF (STATISTICS_START<-1.E6_EB) STATISTICS_START = T_BEGIN + 0.5_EB*(T_END-T_BEGIN)
      IF (STATISTICS_END  > 1.E6_EB) STATISTICS_END   = T_END + TWO_EPSILON_EB
      IF (TEMPORAL_STATISTIC=='null') TEMPORAL_STATISTIC='RUNNING AVERAGE'
   ELSE
      IF (STATISTICS_START<-1.E6_EB) STATISTICS_START = T_BEGIN
      IF (STATISTICS_END  > 1.E6_EB) STATISTICS_END   = T_END + TWO_EPSILON_EB
   ENDIF

   ! Error statement involving POINTS

   IF (POINTS>1 .AND. ANY(XB<-1.E5_EB) .AND. INIT_ID=='null') THEN
      WRITE(MESSAGE,'(A,A,A)')  'ERROR: DEVC ',TRIM(ID),' must have coordinates given in terms of XB'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (LINE_DEVICE .AND. SPATIAL_STATISTIC/='null') THEN
      WRITE(MESSAGE,'(A,A,A)')  'ERROR: DEVC ',TRIM(ID),' cannot use both a steady-state line device and SPATIAL_STATISTIC'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Make ORIENTATION consistent with IOR

   SELECT CASE(IOR)
      CASE( 1) ; ORIENTATION=(/ 1._EB, 0._EB, 0._EB/)
      CASE(-1) ; ORIENTATION=(/-1._EB, 0._EB, 0._EB/)
      CASE( 2) ; ORIENTATION=(/ 0._EB, 1._EB, 0._EB/)
      CASE(-2) ; ORIENTATION=(/ 0._EB,-1._EB, 0._EB/)
      CASE( 3) ; ORIENTATION=(/ 0._EB, 0._EB, 1._EB/)
      CASE(-3) ; ORIENTATION=(/ 0._EB, 0._EB,-1._EB/)
   END SELECT

   ! Add ORIENTATION to global list

   NEW_ORIENTATION_VECTOR = .TRUE.
   ORIENTATION_INDEX = 0

   DO I=1,N_ORIENTATION_VECTOR
      IF (ORIENTATION(1)==ORIENTATION_VECTOR(1,I) .AND. &
          ORIENTATION(2)==ORIENTATION_VECTOR(2,I) .AND. &
          ORIENTATION(3)==ORIENTATION_VECTOR(3,I)) THEN
         NEW_ORIENTATION_VECTOR = .FALSE.
         ORIENTATION_INDEX = I
         EXIT
      ENDIF
   ENDDO

   IF (NEW_ORIENTATION_VECTOR) THEN
      OR_TEMP(1:3) = ORIENTATION(1:3)
      N_ORIENTATION_VECTOR = N_ORIENTATION_VECTOR + 1
      IF (N_ORIENTATION_VECTOR>UBOUND(ORIENTATION_VECTOR,DIM=2)) THEN
         ORIENTATION_VECTOR => REALLOCATE2D(ORIENTATION_VECTOR,1,3,1,N_ORIENTATION_VECTOR+10)
      ENDIF
      IF (ALL(ABS(OR_TEMP(1:3))<TWO_EPSILON_EB)) THEN
         WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(ID),'.  All components of ORIENTATION are zero.'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      ORIENTATION_VECTOR(1:3,N_ORIENTATION_VECTOR) = ORIENTATION(1:3) / NORM2(OR_TEMP)
      ORIENTATION_INDEX = N_ORIENTATION_VECTOR
   ENDIF

   ! Check if there are any devices with specified XB that do not fall within a mesh.

   IF (POINTS==1 .AND. XB(1)>-1.E5_EB) THEN

      IF (QUANTITY/='PATH OBSCURATION' .AND. QUANTITY/='TRANSMISSION') CALL CHECK_XB(XB)

      MESH_DEVICE = 0

      BAD = .TRUE.
      CHECK_MESH_LOOP: DO NM=1,NMESHES
         IF (EVACUATION_ONLY(NM)) CYCLE CHECK_MESH_LOOP
         M=>MESHES(NM)
         OVERLAPPING_X = .TRUE.
         OVERLAPPING_Y = .TRUE.
         OVERLAPPING_Z = .TRUE.
         IF (XB(1)==XB(2) .AND. (XB(1)> M%XF .OR. XB(2)< M%XS)) OVERLAPPING_X = .FALSE.
         IF (XB(1)/=XB(2) .AND. (XB(1)>=M%XF .OR. XB(2)<=M%XS)) OVERLAPPING_X = .FALSE.
         IF (XB(3)==XB(4) .AND. (XB(3)> M%YF .OR. XB(4)< M%YS)) OVERLAPPING_Y = .FALSE.
         IF (XB(3)/=XB(4) .AND. (XB(3)>=M%YF .OR. XB(4)<=M%YS)) OVERLAPPING_Y = .FALSE.
         IF (XB(5)==XB(6) .AND. (XB(5)> M%ZF .OR. XB(6)< M%ZS)) OVERLAPPING_Z = .FALSE.
         IF (XB(5)/=XB(6) .AND. (XB(5)>=M%ZF .OR. XB(6)<=M%ZS)) OVERLAPPING_Z = .FALSE.
         IF (OVERLAPPING_X .AND. OVERLAPPING_Y .AND. OVERLAPPING_Z) THEN
            BAD = .FALSE.
            IF (PROCESS(NM)==MYID) MESH_DEVICE(NM) = 1
            MESH_NUMBER = NM
         ENDIF
      ENDDO CHECK_MESH_LOOP

   ENDIF

   ! Process the point devices along a line, if necessary

   POINTS_LOOP: DO I_POINT=1,POINTS

      IF (POINTS>1 .OR. XB(1)<-1.E5_EB) MESH_DEVICE = 0

      IF (XB(1)>-1.E5_EB) THEN
         IF (TRIM(QUANTITY)=='VELOCITY PATCH') THEN
            IF (XYZ(1) <-1.E5_EB) THEN
               XYZ(1) = XB(1) + (XB(2)-XB(1))/2._EB
               XYZ(2) = XB(3) + (XB(4)-XB(3))/2._EB
               XYZ(3) = XB(5) + (XB(6)-XB(5))/2._EB
            ENDIF
         ELSE
            IF (POINTS > 1) THEN
               XYZ(1) = XB(1) + (XB(2)-XB(1))*REAL(I_POINT-1,EB)/REAL(MAX(POINTS-1,1),EB)
               XYZ(2) = XB(3) + (XB(4)-XB(3))*REAL(I_POINT-1,EB)/REAL(MAX(POINTS-1,1),EB)
               XYZ(3) = XB(5) + (XB(6)-XB(5))*REAL(I_POINT-1,EB)/REAL(MAX(POINTS-1,1),EB)
            ELSE
               XYZ(1) = XB(1) + (XB(2)-XB(1))/2._EB
               XYZ(2) = XB(3) + (XB(4)-XB(3))/2._EB
               XYZ(3) = XB(5) + (XB(6)-XB(5))/2._EB
            ENDIF
         ENDIF
      ELSE
         IF (XYZ(1) < -1.E5_EB .AND. CTRL_ID=='null' .AND. DUCT_ID=='null' .AND. NODE_ID(1)=='null' .AND. INIT_ID=='null' &
            .AND. CELL_L < 0._EB) THEN
            WRITE(MESSAGE,'(A,A,A)')  'ERROR: DEVC ',TRIM(ID),' must have coordinates, even if it is not a point quantity'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ENDIF

      ! Determine which mesh the device is in

      BAD = .TRUE.
      MESH_LOOP: DO NM=1,NMESHES
         IF (EVACUATION_ONLY(NM)) CYCLE MESH_LOOP
         M=>MESHES(NM)
         IF (XYZ(1)>=M%XS .AND. XYZ(1)<=M%XF .AND. XYZ(2)>=M%YS .AND. XYZ(2)<=M%YF .AND. XYZ(3)>=M%ZS .AND. XYZ(3)<=M%ZF) THEN
            IF (ABS(XYZ(1)-M%XS)<TWO_EPSILON_EB) THEN
               IF (IOR==-1) THEN
                  CYCLE MESH_LOOP
               ELSE
                  XYZ(1) = XYZ(1) + 0.01_EB*M%DXI
               ENDIF
            ENDIF
            IF (ABS(XYZ(1)-M%XF)<TWO_EPSILON_EB) THEN
               IF (IOR==1) THEN
                  CYCLE MESH_LOOP
               ELSE
                  XYZ(1) = XYZ(1) - 0.01_EB*M%DXI
               ENDIF
            ENDIF
            IF (ABS(XYZ(2)-M%YS)<TWO_EPSILON_EB) THEN
               IF (IOR==-2) THEN
                  CYCLE MESH_LOOP
               ELSE
                  XYZ(2) = XYZ(2) + 0.01_EB*M%DETA
               ENDIF
            ENDIF
            IF (ABS(XYZ(2)-M%YF)<TWO_EPSILON_EB) THEN
               IF (IOR==2) THEN
                  CYCLE MESH_LOOP
               ELSE
                  XYZ(2) = XYZ(2) - 0.01_EB*M%DETA
               ENDIF
            ENDIF
            IF (ABS(XYZ(3)-M%ZS)<TWO_EPSILON_EB) THEN
               IF (IOR==-3) THEN
                  CYCLE MESH_LOOP
               ELSE
                  XYZ(3) = XYZ(3) + 0.01_EB*M%DZETA
               ENDIF
            ENDIF
            IF (ABS(XYZ(3)-M%ZF)<TWO_EPSILON_EB) THEN
               IF (IOR==3) THEN
                  CYCLE MESH_LOOP
               ELSE
                  XYZ(3) = XYZ(3) - 0.01_EB*M%DZETA
               ENDIF
            ENDIF
            MESH_NUMBER = NM
            BAD = .FALSE.
            IF (PROCESS(NM)==MYID) MESH_DEVICE(NM) = 1
            EXIT MESH_LOOP
         ENDIF
      ENDDO MESH_LOOP

      ! Process EVAC meshes

      EVACUATION_MESH_LOOP: DO NM=1,NMESHES
         IF (.NOT.EVACUATION_SKIP(NM)) CYCLE EVACUATION_MESH_LOOP
         M=>MESHES(NM)
         IF (XYZ(1)>=M%XS .AND. XYZ(1)<=M%XF .AND. XYZ(2)>=M%YS .AND. XYZ(2)<=M%YF .AND. XYZ(3)>=M%ZS .AND. XYZ(3)<=M%ZF) THEN
            IF (BAD) MESH_NUMBER = NM
            IF (.NOT.BAD .AND. EVACUATION .AND. QUANTITY=='TIME' .AND. SETPOINT<=T_BEGIN) THEN
               MESH_NUMBER = NM
               BAD = .FALSE.
            END IF
            EXIT EVACUATION_MESH_LOOP
         ENDIF
      ENDDO EVACUATION_MESH_LOOP

      ! Make sure there is either a QUANTITY or PROP_ID for the DEVICE

      IF (QUANTITY=='null' .AND. PROP_ID=='null') THEN
         WRITE(MESSAGE,'(A,A,A)')  'ERROR: DEVC ',TRIM(ID),' must have either an output QUANTITY or PROP_ID'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (BAD) THEN
         IF (CTRL_ID/='null' .OR. DUCT_ID/='null' .OR. NODE_ID(1)/='null' .OR. INIT_ID/='null' .OR. CELL_L>-1._EB) THEN
            XYZ(1) = MESHES(1)%XS
            XYZ(2) = MESHES(1)%YS
            XYZ(3) = MESHES(1)%ZS
            MESH_NUMBER = 1
            IF (INIT_ID/='null') THEN
               MESH_DEVICE = 1  ! This is the case where a DEVC is assigned to particles specified on an INIT line
            ELSE
               IF (PROCESS(1)==MYID) MESH_DEVICE(1) = 1  ! This refers to HVAC or control logic
            ENDIF
         ELSE
            IF (ALL(EVACUATION_ONLY)) CYCLE READ_DEVC_LOOP
            WRITE(MESSAGE,'(A,A,A)') 'WARNING: DEVC ',TRIM(ID),' is not within any mesh.'
            IF (MYID==0) WRITE(LU_ERR,'(A)') TRIM(MESSAGE)
            CYCLE READ_DEVC_LOOP
         ENDIF
      ENDIF

      ! Don't print out clocks

      IF (QUANTITY=='TIME' .AND. NO_UPDATE_DEVC_ID=='null' .AND. NO_UPDATE_CTRL_ID=='null' ) OUTPUT = .FALSE.

      ! Determine if the DEVC is a TIME or LINE device

      IF (.NOT.LINE_DEVICE .AND. OUTPUT)  N_DEVC_TIME = N_DEVC_TIME + 1
      IF (LINE_DEVICE .AND. I_POINT==1)   N_DEVC_LINE = N_DEVC_LINE + 1

      ! Assign properties to the DEVICE array

      N_DEVC = N_DEVC + 1

      DV => DEVICE(N_DEVC)

      MESH_DEVICE_ARRAY(1:NMESHES,N_DEVC) = MESH_DEVICE(1:NMESHES)

      IF (QUANTITY2/='null') DV%N_QUANTITY = 2

      ALLOCATE(DV%QUANTITY(DV%N_QUANTITY))       ; DV%QUANTITY = 'null'
      ALLOCATE(DV%QUANTITY_INDEX(DV%N_QUANTITY)) ; DV%QUANTITY_INDEX = 0
      ALLOCATE(DV%I(DV%N_QUANTITY))
      ALLOCATE(DV%J(DV%N_QUANTITY))
      ALLOCATE(DV%K(DV%N_QUANTITY))

      DV%RELATIVE          = RELATIVE
      DV%CONVERSION_ADDEND = CONVERSION_ADDEND
      DV%CONVERSION_FACTOR = CONVERSION_FACTOR
      DV%COORD_FACTOR      = COORD_FACTOR
      DV%DEPTH             = DEPTH
      DV%IOR               = IOR
      IF (POINTS>1 .AND. POINTS<=99 .AND. .NOT.LINE_DEVICE) THEN
         WRITE(DV%ID,'(A,A,I2.2)') TRIM(ID),'-',I_POINT
      ELSEIF (POINTS>99 .AND. POINTS<=999 .AND. .NOT.LINE_DEVICE) THEN
         WRITE(DV%ID,'(A,A,I3.3)') TRIM(ID),'-',I_POINT
      ELSEIF (POINTS>999 .AND. .NOT.LINE_DEVICE) THEN
         WRITE(DV%ID,'(A,A,I6.6)') TRIM(ID),'-',I_POINT
      ELSE
         DV%ID             = ID
      ENDIF
      IF (LINE_DEVICE) DV%LINE = N_DEVC_LINE
      DV%POINT             = I_POINT
      DV%MESH              = MESH_NUMBER
      DV%ORDINAL           = NN
      DV%ORIENTATION_INDEX = ORIENTATION_INDEX
      DV%PROP_ID           = PROP_ID
      DV%DEVC_ID           = DEVC_ID
      DV%CTRL_ID           = CTRL_ID
      DV%SURF_ID           = SURF_ID
      DV%PART_ID           = PART_ID
      DV%MATL_ID           = MATL_ID
      DV%SPEC_ID           = SPEC_ID
      DV%DUCT_ID           = DUCT_ID
      DV%INIT_ID           = INIT_ID
      DV%MOVE_ID           = MOVE_ID
      DV%NODE_ID           = NODE_ID
      DV%REAC_ID           = REAC_ID
      DV%CELL_L            = CELL_L
      DV%TIME_PERIOD       = TIME_PERIOD
      DV%N_INTERVALS       = N_INTERVALS
      DV%QUANTITY(1)       = QUANTITY
      IF (QUANTITY2/='null') DV%QUANTITY(2) = QUANTITY2
      DV%ROTATION          = ROTATION*TWOPI/360._EB
      DV%SETPOINT          = SETPOINT
      DV%LATCH             = LATCH
      DV%OUTPUT            = OUTPUT
      DV%ABSOLUTE_VALUE    = ABSOLUTE_VALUE
      DV%ORIENTATION_NUMBER = ORIENTATION_NUMBER
      DV%TRIP_DIRECTION    = TRIP_DIRECTION
      DV%INITIAL_STATE     = INITIAL_STATE
      DV%CURRENT_STATE     = INITIAL_STATE
      DV%PRIOR_STATE       = INITIAL_STATE
      DV%FLOWRATE          = FLOWRATE
      DV%BYPASS_FLOWRATE   = BYPASS_FLOWRATE
      DV%SMOOTHING_FACTOR  = SMOOTHING_FACTOR
      DV%SPATIAL_STATISTIC = SPATIAL_STATISTIC
      DV%TEMPORAL_STATISTIC= TEMPORAL_STATISTIC
      DV%STATISTICS_END    = STATISTICS_END
      DV%STATISTICS_START  = STATISTICS_START
      DV%SURF_INDEX        = 0
      DV%UNITS             = UNITS
      DV%XYZ_UNITS         = XYZ_UNITS
      DV%DELAY             = DELAY / TIME_SHRINK_FACTOR
      DV%X1                = XB(1)
      DV%X2                = XB(2)
      DV%Y1                = XB(3)
      DV%Y2                = XB(4)
      DV%Z1                = XB(5)
      DV%Z2                = XB(6)
      IF (ABS(DV%X1-DV%X2)<=SPACING(DV%X2) .AND. DV%IOR==0) DV%IOR_ASSUMED = 1
      IF (ABS(DV%Y1-DV%Y2)<=SPACING(DV%Y2) .AND. DV%IOR==0) DV%IOR_ASSUMED = 2
      IF (ABS(DV%Z1-DV%Z2)<=SPACING(DV%Z2) .AND. DV%IOR==0) DV%IOR_ASSUMED = 3
      DV%X                 = XYZ(1)
      DV%Y                 = XYZ(2)
      DV%Z                 = XYZ(3)
      IF (X_ID=='null') X_ID = TRIM(ID)//'-x'
      IF (Y_ID=='null') Y_ID = TRIM(ID)//'-y'
      IF (Z_ID=='null') Z_ID = TRIM(ID)//'-z'
      DV%D_ID              = D_ID
      DV%R_ID              = R_ID
      DV%X_ID              = X_ID
      DV%Y_ID              = Y_ID
      DV%Z_ID              = Z_ID
      DV%DRY               = DRY
      DV%EVACUATION        = EVACUATION
      DV%VELO_INDEX        = VELO_INDEX
      DV%PIPE_INDEX        = PIPE_INDEX
      DV%NO_UPDATE_DEVC_ID = NO_UPDATE_DEVC_ID
      DV%NO_UPDATE_CTRL_ID = NO_UPDATE_CTRL_ID
      DV%QUANTITY_RANGE    = QUANTITY_RANGE
      DV%HIDE_COORDINATES  = HIDE_COORDINATES
      IF (NORM2(ORIENTATION)<1.E5_EB) THEN
         DV%OVEC = ORIENTATION/NORM2(ORIENTATION)
      ELSE
         DV%OVEC = (/0._EB,0._EB,0._EB/)
      ENDIF
      IF (NORM2(FORCE_DIRECTION)<1.E5_EB) THEN
         DV%DFVEC = FORCE_DIRECTION/NORM2(FORCE_DIRECTION)
      ELSE
         DV%DFVEC = (/0._EB,0._EB,0._EB/)
      ENDIF

      IF (LINE_DEVICE) THEN
         IF (.NOT.DV%HIDE_COORDINATES) THEN
            IF (ABS(XB(1)-XB(2))> SPACING(XB(2)) .AND. ABS(XB(3)-XB(4))<=SPACING(XB(4)) .AND. &
               ABS(XB(5)-XB(6))<=SPACING(XB(6))) DV%LINE_COORD_CODE = 1
            IF (ABS(XB(1)-XB(2))<=SPACING(XB(2)) .AND. ABS(XB(3)-XB(4))> SPACING(XB(4)) .AND. &
               ABS(XB(5)-XB(6))<=SPACING(XB(6))) DV%LINE_COORD_CODE = 2
            IF (ABS(XB(1)-XB(2))<=SPACING(XB(2)) .AND. ABS(XB(3)-XB(4))<=SPACING(XB(4)) .AND. &
               ABS(XB(5)-XB(6))> SPACING(XB(6))) DV%LINE_COORD_CODE = 3
            IF (ABS(XB(1)-XB(2))> SPACING(XB(2)) .AND. ABS(XB(3)-XB(4))> SPACING(XB(4)) .AND. &
               ABS(XB(5)-XB(6))<=SPACING(XB(6))) DV%LINE_COORD_CODE = 12
            IF (ABS(XB(1)-XB(2))> SPACING(XB(2)) .AND. ABS(XB(3)-XB(4))<=SPACING(XB(4)) .AND. &
               ABS(XB(5)-XB(6))> SPACING(XB(6))) DV%LINE_COORD_CODE = 13
            IF (ABS(XB(1)-XB(2))<=SPACING(XB(2)) .AND. ABS(XB(3)-XB(4))> SPACING(XB(4)) .AND. &
               ABS(XB(5)-XB(6))> SPACING(XB(6))) DV%LINE_COORD_CODE = 23
            IF (DV%R_ID/='null') DV%LINE_COORD_CODE = 4  ! Special case where radial coordinates are requested
            IF (DV%D_ID/='null') DV%LINE_COORD_CODE = 5  ! Special case where distance from origin is requested
         ELSE
            DV%LINE_COORD_CODE = 0
         ENDIF
      ENDIF

      ! Special case for QUANTITY='RADIATIVE HEAT FLUX GAS' or 'ADIABATIC SURFACE TEMPERATURE GAS'.
      ! Save information to create INIT line.

      IF (DV%QUANTITY(1)=='RADIATIVE HEAT FLUX GAS' .OR. &
          DV%QUANTITY(1)=='RADIANCE' .OR. &
          DV%QUANTITY(1)=='ADIABATIC SURFACE TEMPERATURE GAS') THEN
         DV%INIT_ID = DV%ID
         TARGET_PARTICLES_INCLUDED = .TRUE.
         IF (DV%POINT==1 .OR. TIME_HISTORY) THEN
            DV%POINT = 1
            N_INIT_RESERVED = N_INIT_RESERVED + 1
            INIT_RESERVED(N_INIT_RESERVED)%DEVC_INDEX = N_DEVC
            INIT_RESERVED(N_INIT_RESERVED)%N_PARTICLES = POINTS
         ENDIF
      ENDIF

      ! Miscellaneous actions taken based on specific device attributes

      IF (TRIM(DV%QUANTITY(1)) == 'CHEMISTRY SUBITERATIONS') OUTPUT_CHEM_IT = .TRUE.
      IF (TRIM(DV%QUANTITY(1)) == 'REAC SOURCE TERM' .OR. TRIM(DV%QUANTITY(1)) == 'HRRPUV REAC') REAC_SOURCE_CHECK=.TRUE.
      IF (TRIM(QUANTITY)=='SOLID CELL Q_S') STORE_Q_DOT_PPP_S = .TRUE.
      IF (TRIM(QUANTITY)=='DUDT' .OR. TRIM(QUANTITY)=='DVDT' .OR. TRIM(QUANTITY)=='DWDT') STORE_OLD_VELOCITY=.TRUE.
      IF (TRIM(DV%QUANTITY(1))=='HRRPUV REAC' .AND. TRIM(DV%SPATIAL_STATISTIC)=='VOLUME INTEGRAL' .AND. &
          TRIM(DV%TEMPORAL_STATISTIC)=='TIME INTEGRAL' .AND. TRIM(DV%UNITS)=='kg') DV%USE_PREVIOUS_VALUE=.TRUE.

      IF (DV%SPATIAL_STATISTIC(1:3)=='MIN') MIN_DEVICES_EXIST = .TRUE.
      IF (DV%SPATIAL_STATISTIC(1:3)=='MAX') MAX_DEVICES_EXIST = .TRUE.

      IF (DV%TEMPORAL_STATISTIC=='MIN' .OR. DV%TEMPORAL_STATISTIC=='MAX') THEN
         IF (DV%TIME_PERIOD>0._EB) THEN
            IF (DV%N_INTERVALS<0) DV%N_INTERVALS = 10
         ELSE
            DV%N_INTERVALS = 1
         ENDIF
         IF (DV%TEMPORAL_STATISTIC=='MIN') THEN
            ALLOCATE(DV%TIME_MIN_VALUE(DV%N_INTERVALS))
            DV%TIME_MIN_VALUE = 1.E20_EB
         ELSE
            ALLOCATE(DV%TIME_MAX_VALUE(DV%N_INTERVALS))
            DV%TIME_MAX_VALUE = -1.E20_EB
         ENDIF
      ENDIF

   ENDDO POINTS_LOOP

ENDDO READ_DEVC_LOOP

ALLOCATE (DEVC_PIPE_OPERATING(MAXVAL(DEVICE%PIPE_INDEX)))
DEVC_PIPE_OPERATING = 0

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

! Loop through the meshes and record info for only those devices in the mesh

DEVICE_LOOP: DO N=1,N_DEVC

   DV => DEVICE(N)
   ALLOCATE(DV%SUBDEVICE_INDEX(NMESHES),STAT=IZERO) ;   CALL ChkMemErr('READ','SUBDEVICE_INDEX',IZERO)
   DV%SUBDEVICE_INDEX = 0
   DV%N_SUBDEVICES = SUM(MESH_DEVICE_ARRAY(:,N))
   IF (DV%N_SUBDEVICES==0) CYCLE DEVICE_LOOP

   ALLOCATE(DV%SUBDEVICE(DV%N_SUBDEVICES),STAT=IZERO) ; CALL ChkMemErr('READ','SUBDEVICE',IZERO)

   NN = 0

   MESH_LOOP_2: DO NM=1,NMESHES

      IF (MESH_DEVICE_ARRAY(NM,N)==0) CYCLE MESH_LOOP_2

      NN = NN + 1
      DV%SUBDEVICE_INDEX(NM) = NN
      SDV => DV%SUBDEVICE(NN)
      SDV%MESH = NM

      M=>MESHES(NM)

      IF (DV%X1>-1.E5_EB) THEN
         SDV%X1 = MAX(DV%X1,M%XS)
         SDV%X2 = MIN(DV%X2,M%XF)
         SDV%Y1 = MAX(DV%Y1,M%YS)
         SDV%Y2 = MIN(DV%Y2,M%YF)
         SDV%Z1 = MAX(DV%Z1,M%ZS)
         SDV%Z2 = MIN(DV%Z2,M%ZF)
         SDV%I1 = NINT( GINV(SDV%X1-M%XS,1,NM)*M%RDXI )
         SDV%I2 = NINT( GINV(SDV%X2-M%XS,1,NM)*M%RDXI )
         SDV%J1 = NINT( GINV(SDV%Y1-M%YS,2,NM)*M%RDETA )
         SDV%J2 = NINT( GINV(SDV%Y2-M%YS,2,NM)*M%RDETA )
         SDV%K1 = NINT( GINV(SDV%Z1-M%ZS,3,NM)*M%RDZETA )
         SDV%K2 = NINT( GINV(SDV%Z2-M%ZS,3,NM)*M%RDZETA )
         IF (SDV%I1<SDV%I2) SDV%I1 = SDV%I1 + 1
         IF (SDV%J1<SDV%J2) SDV%J1 = SDV%J1 + 1
         IF (SDV%K1<SDV%K2) SDV%K1 = SDV%K1 + 1
      ENDIF

   ENDDO MESH_LOOP_2
ENDDO DEVICE_LOOP

DEALLOCATE(MESH_DEVICE)
DEALLOCATE(MESH_DEVICE_ARRAY)

CONTAINS

SUBROUTINE SET_DEVC_DEFAULTS

ABSOLUTE_VALUE   = .FALSE.
RELATIVE         = .FALSE.
CONVERSION_ADDEND = 0._EB
CONVERSION_FACTOR = 1._EB
COORD_FACTOR     = 1._EB
DEPTH            = 0._EB
IOR              = 0
ID               = 'null'
ORIENTATION(1:3) = (/0._EB,0._EB,-1.E6_EB/)
FORCE_DIRECTION(1:3) = (/0._EB,0._EB,-1.E6_EB/)
PROP_ID          = 'null'
CTRL_ID          = 'null'
DEVC_ID          = 'null'
SURF_ID          = 'null'
PART_ID          = 'null'
MATL_ID          = 'null'
SPEC_ID          = 'null'
DUCT_ID          = 'null'
INIT_ID          = 'null'
MOVE_ID          = 'null'
NODE_ID          = 'null'
REAC_ID          = 'null'
CELL_L           = -1._EB
FLOWRATE         = 0._EB
DELAY            = 0._EB
BYPASS_FLOWRATE  = 0._EB
QUANTITY         = 'null'
QUANTITY2        = 'null'
ROTATION         = 0._EB
XB(1)            = -1.E6_EB
XB(2)            =  1.E6_EB
XB(3)            = -1.E6_EB
XB(4)            =  1.E6_EB
XB(5)            = -1.E6_EB
XB(6)            =  1.E6_EB
DB               = 'null'
INITIAL_STATE    = .FALSE.
LATCH            = .TRUE.
OUTPUT           = .TRUE.
ORIENTATION_NUMBER = 1
POINTS           = 1
SETPOINT         = 1.E20_EB
SMOOTHING_FACTOR = 0._EB
STATISTICS       = 'null'
SPATIAL_STATISTIC= 'null'
TEMPORAL_STATISTIC= 'null'
STATISTICS_START = -1.E20_EB
STATISTICS_END   =  1.E20_EB
TRIP_DIRECTION   = 1
TIME_AVERAGED    = .TRUE.
TIME_HISTORY     = .FALSE.
UNITS            = 'null'
XYZ_UNITS        = 'm'
VELO_INDEX       = 0
XYZ              = -1.E6_EB
D_ID             = 'null'
R_ID             = 'null'
X_ID             = 'null'
Y_ID             = 'null'
Z_ID             = 'null'
HIDE_COORDINATES = .FALSE.
DRY              = .FALSE.
EVACUATION       = .FALSE.
PIPE_INDEX       = 1
NO_UPDATE_DEVC_ID= 'null'
NO_UPDATE_CTRL_ID= 'null'
QUANTITY_RANGE(1)= -1.E50_EB
QUANTITY_RANGE(2)=  1.E50_EB
N_INTERVALS      = -1
TIME_PERIOD      = -1._EB

END SUBROUTINE SET_DEVC_DEFAULTS

END SUBROUTINE READ_DEVC


!> \brief Read the ConTRoL namelist lines

SUBROUTINE READ_CTRL

USE CONTROL_VARIABLES
USE MATH_FUNCTIONS, ONLY : GET_RAMP_INDEX

LOGICAL :: INITIAL_STATE, LATCH, EVACUATION
INTEGER :: N,NC,TRIP_DIRECTION
REAL(EB) :: SETPOINT(2), DELAY,CONSTANT,PROPORTIONAL_GAIN,INTEGRAL_GAIN,DIFFERENTIAL_GAIN,TARGET_VALUE
CHARACTER(LABEL_LENGTH) :: ID,FUNCTION_TYPE,INPUT_ID(MAX_INPUT_ID),RAMP_ID,ON_BOUND
TYPE (CONTROL_TYPE), POINTER :: CF=>NULL()
NAMELIST /CTRL/  CONSTANT,DELAY,DIFFERENTIAL_GAIN,EVACUATION,FUNCTION_TYPE,ID,INITIAL_STATE,&
                 INPUT_ID,INTEGRAL_GAIN,LATCH,N,ON_BOUND,PROPORTIONAL_GAIN,RAMP_ID,&
                 SETPOINT,TARGET_VALUE,TRIP_DIRECTION

N_CTRL = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_CTRL_LOOP: DO
   CALL CHECKREAD('CTRL',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_CTRL_LOOP
   READ(LU_INPUT,NML=CTRL,END=11,ERR=12,IOSTAT=IOS)
   N_CTRL = N_CTRL + 1
   12 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with CTRL number ',N_CTRL+1,', line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDDO COUNT_CTRL_LOOP
11 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (N_CTRL==0) RETURN

! Allocate CONTROL array and set initial values of all to 0

ALLOCATE(CONTROL(N_CTRL),STAT=IZERO)
CALL ChkMemErr('READ','CONTROL',IZERO)

! Read in the CTRL lines

READ_CTRL_LOOP: DO NC=1,N_CTRL

   CALL CHECKREAD('CTRL',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_CTRL_LOOP
   CALL SET_CTRL_DEFAULTS
   READ(LU_INPUT,CTRL)

   ! Make sure there is either a FUNCTION_TYPE type for the CTRL

   IF (FUNCTION_TYPE=='null') THEN
      WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CTRL ',NC,' must have a FUNCTION_TYPE'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! Assign properties to the CONTROL array

   CF => CONTROL(NC)
   CF%CONSTANT        = CONSTANT
   CF%ID              = ID
   CF%LATCH           = LATCH
   CF%INITIAL_STATE   = INITIAL_STATE
   CF%CURRENT_STATE   = INITIAL_STATE
   CF%PRIOR_STATE     = INITIAL_STATE
   CF%SETPOINT        = SETPOINT
   CF%DELAY           = DELAY / TIME_SHRINK_FACTOR
   CF%RAMP_ID         = RAMP_ID
   CF%N               = N
   CF%INPUT_ID        = INPUT_ID
   CF%EVACUATION      = EVACUATION
   CF%TRIP_DIRECTION  = TRIP_DIRECTION
   CF%PROPORTIONAL_GAIN =PROPORTIONAL_GAIN
   CF%INTEGRAL_GAIN = INTEGRAL_GAIN
   CF%DIFFERENTIAL_GAIN = DIFFERENTIAL_GAIN
   CF%TARGET_VALUE = TARGET_VALUE
   IF (ON_BOUND=='UPPER') THEN
      CF%ON_BOUND = 1
   ELSE
      CF%ON_BOUND = -1
   ENDIF
   !Assign control index
   SELECT CASE(FUNCTION_TYPE)
      CASE('ALL')
         CF%CONTROL_INDEX = AND_GATE
      CASE('ANY')
         CF%CONTROL_INDEX = OR_GATE
      CASE('ONLY')
         CF%CONTROL_INDEX = XOR_GATE
      CASE('AT_LEAST')
         CF%CONTROL_INDEX = X_OF_N_GATE
      CASE('TIME_DELAY')
         CF%CONTROL_INDEX = TIME_DELAY
      CASE('DEADBAND')
         CF%CONTROL_INDEX = DEADBAND
      CASE('CYCLING')
         CF%CONTROL_INDEX = CYCLING
      CASE('CUSTOM')
         CF%CONTROL_INDEX = CUSTOM
         CALL GET_RAMP_INDEX(RAMP_ID,'CONTROL',CF%RAMP_INDEX)
         CF%LATCH = .FALSE.
      CASE('KILL')
         CF%CONTROL_INDEX = KILL
      CASE('RESTART')
         CF%CONTROL_INDEX = CORE_DUMP
      CASE('SUM')
         CF%CONTROL_INDEX = CF_SUM
      CASE('SUBTRACT')
         CF%CONTROL_INDEX = CF_SUBTRACT
      CASE('MULTIPLY')
         CF%CONTROL_INDEX = CF_MULTIPLY
      CASE('DIVIDE')
         CF%CONTROL_INDEX = CF_DIVIDE
      CASE('POWER')
         CF%CONTROL_INDEX = CF_POWER
      CASE('EXP')
         CF%CONTROL_INDEX = CF_EXP
      CASE('LOG')
         CF%CONTROL_INDEX = CF_LOG
      CASE('SIN')
         CF%CONTROL_INDEX = CF_SIN
      CASE('COS')
         CF%CONTROL_INDEX = CF_COS
      CASE('ASIN')
         CF%CONTROL_INDEX = CF_ASIN
      CASE('ACOS')
         CF%CONTROL_INDEX = CF_ACOS
      CASE('MIN')
         CF%CONTROL_INDEX = CF_MIN
      CASE('MAX')
         CF%CONTROL_INDEX = CF_MAX
      CASE('ABS')
         CF%CONTROL_INDEX = CF_ABS
      CASE('PID')
         CF%CONTROL_INDEX = CF_PID
         IF (CF%TARGET_VALUE<-1.E30_EB) THEN
            WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CTRL ',NC,', PID controller must be given a TARGET_VALUE'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      CASE DEFAULT
         WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CTRL ',NC,' FUNCTION_TYPE not recognized'
         CALL SHUTDOWN(MESSAGE) ; RETURN
   END SELECT

ENDDO READ_CTRL_LOOP
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

CONTAINS

SUBROUTINE SET_CTRL_DEFAULTS
   CONSTANT      = -9.E30_EB
   ID            = 'null'
   LATCH         = .TRUE.
   INITIAL_STATE = .FALSE.
   SETPOINT      = 1.E30_EB
   DELAY         = 0._EB
   FUNCTION_TYPE = 'null'
   RAMP_ID       = 'null'
   INPUT_ID      = 'null'
   ON_BOUND      = 'LOWER'
   N             = 1
   EVACUATION    = .FALSE.
   TRIP_DIRECTION = 1
   PROPORTIONAL_GAIN = 1._EB
   INTEGRAL_GAIN     = 0._EB
   DIFFERENTIAL_GAIN = 0._EB
   TARGET_VALUE      = 0._EB

END SUBROUTINE SET_CTRL_DEFAULTS

END SUBROUTINE READ_CTRL


!> \brief Process the CONTROL function parameters

SUBROUTINE PROC_CTRL

USE CONTROL_VARIABLES
USE DEVICE_VARIABLES, ONLY: N_DEVC,DEVICE
LOGICAL :: CONSTANT_SPECIFIED,TSF_WARNING=.FALSE.
INTEGER :: NC,NN,NNN
TYPE (CONTROL_TYPE), POINTER :: CF=>NULL()

PROC_CTRL_LOOP: DO NC = 1, N_CTRL

   CF => CONTROL(NC)
   CONSTANT_SPECIFIED = .FALSE.
   IF (CF%CONTROL_INDEX== TIME_DELAY) TSF_WARNING=.TRUE.
   ! setup input array

   CF%N_INPUTS = 0
   INPUT_COUNT: DO NN=1,MAX_INPUT_ID
      IF (CF%INPUT_ID(NN)=='null') EXIT INPUT_COUNT
   END DO INPUT_COUNT
   CF%N_INPUTS=NN-1
   IF (CF%N_INPUTS==0) THEN
      WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CTRL ',NC,' must have at least one input'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   SELECT CASE (CF%CONTROL_INDEX)
      CASE (CF_SUBTRACT,CF_DIVIDE,CF_POWER)
         IF (CF%N_INPUTS /= 2) THEN
            WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CTRL ',NC,' must have at only two inputs'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      CASE (CF_SUM,CF_MULTIPLY)
      CASE DEFAULT
         IF (ANY(CF%INPUT_ID=='CONSTANT')) THEN
            WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CTRL ',NC,' the INTPUT_ID of CONSTANT cannot be used'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      END SELECT
   ALLOCATE (CF%INPUT(CF%N_INPUTS),STAT=IZERO)
   CALL ChkMemErr('READ','CF%INPUT',IZERO)
   ALLOCATE (CF%INPUT_TYPE(CF%N_INPUTS),STAT=IZERO)
   CALL ChkMemErr('READ','CF%INPUT_TYPE',IZERO)
   CF%INPUT_TYPE = -1

   BUILD_INPUT: DO NN = 1, CF%N_INPUTS
      IF (TRIM(CF%INPUT_ID(NN))==TRIM(CF%ID)) THEN
         WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CTRL ',NC,' cannot use a control function as an input to itself'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (CF%INPUT_ID(NN)=='CONSTANT') THEN
         IF (CONSTANT_SPECIFIED) THEN
            WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CTRL ',NC,' can only specify one input as a constant value'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (CF%CONSTANT < -8.E30_EB) THEN
            WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CTRL ',NC,' has the INPUT_ID CONSTANT but no constant value was specified'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         CF%INPUT_TYPE(NN) = CONSTANT_INPUT
         CONSTANT_SPECIFIED = .TRUE.
         CYCLE BUILD_INPUT
      ENDIF
      CTRL_LOOP: DO NNN = 1, N_CTRL
         IF (CONTROL(NNN)%ID == CF%INPUT_ID(NN)) THEN
            CF%INPUT(NN) = NNN
            CF%INPUT_TYPE(NN) = CONTROL_INPUT
            IF (CF%CONTROL_INDEX == CUSTOM) THEN
               WRITE(MESSAGE,'(A,I0,A)')  'ERROR: CUSTOM CTRL ',NC,' cannot have another CTRL as input'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            EXIT CTRL_LOOP
         ENDIF
      END DO CTRL_LOOP
      DEVC_LOOP: DO NNN = 1, N_DEVC
         IF (DEVICE(NNN)%ID == CF%INPUT_ID(NN)) THEN
            IF (ANY(DEVICE(NNN)%QUANTITY_INDEX==41)) TSF_WARNING=.TRUE.
            IF (CF%INPUT_TYPE(NN) > 0) THEN
               WRITE(MESSAGE,'(A,I0,A,I0,A)')  'ERROR: CTRL ',NC,' input ',NN,' is the ID for both a DEVC and a CTRL'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            CF%INPUT(NN) = NNN
            CF%INPUT_TYPE(NN) = DEVICE_INPUT
            EXIT DEVC_LOOP
         ENDIF
      END DO DEVC_LOOP
      IF (CF%INPUT_TYPE(NN) > 0) CYCLE BUILD_INPUT
      WRITE(MESSAGE,'(A,I0,A,A)')  'ERROR: CTRL ',NC,' cannot locate item for input ', TRIM(CF%INPUT_ID(NN))
      CALL SHUTDOWN(MESSAGE) ; RETURN
      IF (ALL(EVACUATION_ONLY)) CYCLE BUILD_INPUT
   END DO BUILD_INPUT

END DO PROC_CTRL_LOOP

IF (ABS(TIME_SHRINK_FACTOR-1._EB)>TWO_EPSILON_EB .AND. TSF_WARNING) THEN
    IF (MYID==0)  WRITE(LU_ERR,'(A)') 'WARNING: One or more time based CTRL functions are being used with TIME_SHRINK_FACTOR'
ENDIF

END SUBROUTINE PROC_CTRL


!> \brief Process the OBSTruction parameters

SUBROUTINE PROC_OBST

USE GEOMETRY_FUNCTIONS, ONLY: BLOCK_CELL
INTEGER :: NM,N,I,J,K,IS,JS,KS,IC1,IC2

MESH_LOOP: DO NM=1,NMESHES

   IF (PROCESS(NM)/=MYID)   CYCLE MESH_LOOP
   IF (EVACUATION_ONLY(NM)) CYCLE MESH_LOOP

   M=>MESHES(NM)
   CALL POINT_TO_MESH(NM)

   ! Assign a property index to the obstruction for use in Smokeview

   DO N=1,N_OBST
      OB=>OBSTRUCTION(N)
      IF (OB%PROP_ID /='null') THEN
         CALL GET_PROPERTY_INDEX(OB%PROP_INDEX,'OBST',OB%PROP_ID)
      ENDIF
   ENDDO

   ! Make mesh edge cells not solid if cells on either side are not solid

   DO K=0,KBP1,KBP1
      IF (K==0) THEN ; KS=1 ; ELSE ; KS=-1 ; ENDIF
      DO J=0,JBP1,JBP1
         IF (J==0) THEN ; JS=1 ; ELSE ; JS=-1 ; ENDIF
         DO I=1,IBAR
            IC1 = CELL_INDEX(I,J+JS,K) ; IC2 = CELL_INDEX(I,J,K+KS)
            IF (.NOT.SOLID(IC1) .AND. .NOT.SOLID(IC2)) CALL BLOCK_CELL(NM,I,I,J,J,K,K,0,0)
         ENDDO
      ENDDO
   ENDDO

   DO K=0,KBP1,KBP1
      IF (K==0) THEN ; KS=1 ; ELSE ; KS=-1 ; ENDIF
      DO I=0,IBP1,IBP1
         IF (I==0) THEN ; IS=1 ; ELSE ; IS=-1 ; ENDIF
         DO J=1,JBAR
            IC1 = CELL_INDEX(I+IS,J,K) ; IC2 = CELL_INDEX(I,J,K+KS)
            IF (.NOT.SOLID(IC1) .AND. .NOT.SOLID(IC2)) CALL BLOCK_CELL(NM,I,I,J,J,K,K,0,0)
         ENDDO
      ENDDO
   ENDDO

   DO J=0,JBP1,JBP1
      IF (J==0) THEN ; JS=1 ; ELSE ; JS=-1 ; ENDIF
      DO I=0,IBP1,IBP1
         IF (I==0) THEN ; IS=1 ; ELSE ; IS=-1 ; ENDIF
         DO K=1,KBAR
            IC1 = CELL_INDEX(I+IS,J,K) ; IC2 = CELL_INDEX(I,J+JS,K)
            IF (.NOT.SOLID(IC1) .AND. .NOT.SOLID(IC2)) CALL BLOCK_CELL(NM,I,I,J,J,K,K,0,0)
         ENDDO
      ENDDO
   ENDDO

ENDDO MESH_LOOP


END SUBROUTINE PROC_OBST


!> \brief Process the DEViCes

SUBROUTINE PROC_DEVC

USE COMP_FUNCTIONS, ONLY: CHANGE_UNITS
USE GEOMETRY_FUNCTIONS, ONLY: SEARCH_OTHER_MESHES
USE CONTROL_VARIABLES
USE DEVICE_VARIABLES, ONLY: DEVICE_TYPE,SUBDEVICE_TYPE,DEVICE,N_DEVC,PROPERTY,PROPERTY_TYPE,MAX_HISTOGRAM_NBINS,&
                            N_HISTOGRAM

INTEGER  :: N,NN,NNN,NS,MAXCELLS,I,J,K,NOM
REAL(EB) :: XX,YY,ZZ,DISTANCE,SCANDISTANCE,DX,DY,DZ,XI,YJ,ZK
TYPE (DEVICE_TYPE),  POINTER :: DV=>NULL()
TYPE (SUBDEVICE_TYPE),  POINTER :: SDV=>NULL()

IF (N_DEVC==0) RETURN

! Loop through all devices and set initial values

PROC_DEVC_LOOP: DO N=1,N_DEVC

   DV => DEVICE(N)

   ! Check for HVAC outputs with no HVAC inputs

   IF ((DV%DUCT_ID/='null' .OR. DV%NODE_ID(1)/='null') .AND. .NOT. HVAC_SOLVE) THEN
      WRITE(MESSAGE,'(A)')  'ERROR: HVAC outputs specified with no HVAC inputs'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   ! If the Device has a SURF_ID, get the SURF_INDEX

   IF (DV%SURF_ID/='null') THEN
      DO NN=1,N_SURF
         IF (SURFACE(NN)%ID==DV%SURF_ID) DV%SURF_INDEX = NN
      ENDDO
   ENDIF

   ! Check if the device PROPERTY exists and is appropriate

   DV%PROP_INDEX = 0
   IF (DV%PROP_ID /='null') THEN
      CALL GET_PROPERTY_INDEX(DV%PROP_INDEX,'DEVC',DV%PROP_ID)
      IF (DV%QUANTITY(1)=='null' .AND. PROPERTY(DV%PROP_INDEX)%QUANTITY=='null') THEN
         WRITE(MESSAGE,'(5A)')  'ERROR: DEVC ',TRIM(DV%ID),' or DEVC PROPerty ',TRIM(DV%PROP_ID),' must have a QUANTITY'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
      IF (DV%QUANTITY(1)=='null' .AND. PROPERTY(DV%PROP_INDEX)%QUANTITY/='null') DV%QUANTITY(1) = PROPERTY(DV%PROP_INDEX)%QUANTITY
   ENDIF

   ! Check if the output QUANTITY exists and is appropriate

   QUANTITY_IF: IF (DV%QUANTITY(1) /= 'null') THEN
      CALL GET_QUANTITY_INDEX(DV%SMOKEVIEW_LABEL,DV%SMOKEVIEW_BAR_LABEL,DV%QUANTITY_INDEX(1),I_DUM(1), &
                              DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,DV%DUCT_INDEX,DV%NODE_INDEX(1),&
                              DV%REAC_INDEX,DV%MATL_INDEX,'DEVC', &
                              DV%QUANTITY(1),'null',DV%SPEC_ID,DV%PART_ID,DV%DUCT_ID,DV%NODE_ID(1),DV%REAC_ID,DV%MATL_ID,&
                              DV%CELL_L,DV%DUCT_CELL_INDEX)

      IF (DV%QUANTITY(1)=='CONTROL' .OR. DV%QUANTITY(1)=='CONTROL VALUE') UPDATE_DEVICES_AGAIN = .TRUE.

      IF (DV%TEMPORAL_STATISTIC=='null') THEN
         IF (OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%TIME_AVERAGED) THEN
            DV%TEMPORAL_STATISTIC = 'TIME AVERAGE'
         ELSE
            DV%TEMPORAL_STATISTIC = 'INSTANT VALUE'
         ENDIF
      ENDIF

      IF (OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%INTEGRATED .AND. DV%X1<=-1.E6_EB) THEN
         WRITE(MESSAGE,'(3A)')  'ERROR: DEVC QUANTITY ',TRIM(DV%QUANTITY(1)),' requires coordinates using XB'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      ! This check is commented as DEVCs with IOR==0 can be related to CFACES. The test that IOR/=0 for WALL CELLS
      ! is done in init.f90 routine INITIALIZE_DEVICES (IOR==0 but no CFACE found).
      !IF (DV%QUANTITY_INDEX(1)<0 .AND. DV%IOR==0 .AND. (DV%SPATIAL_STATISTIC=='null'.OR.DV%LINE>0) .AND. DV%INIT_ID=='null') !THEN
      !   WRITE(MESSAGE,'(A,A,A)') 'ERROR: Specify orientation of DEVC ',TRIM(DV%ID),' using the parameter IOR'
      !   CALL SHUTDOWN(MESSAGE) ; RETURN
      !ENDIF

      IF (DV%QUANTITY_INDEX(1) < 0 .AND. (DV%SPATIAL_STATISTIC=='MASS MEAN' .OR. DV%SPATIAL_STATISTIC=='VOLUME MEAN' .OR. &
                                          DV%SPATIAL_STATISTIC=='VOLUME INTEGRAL' .OR. DV%SPATIAL_STATISTIC=='MASS INTEGRAL' .OR. &
                                          DV%SPATIAL_STATISTIC=='MASS' .OR. DV%SPATIAL_STATISTIC=='VOLUME')) THEN
         WRITE(MESSAGE,'(A,A)') 'ERROR: Invalid SPATIAL_STATISTIC specified for wall DEVC ',TRIM(DV%ID)
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (DV%QUANTITY_INDEX(1) > 0 .AND. (DV%SPATIAL_STATISTIC=='SURFACE INTEGRAL' .OR. DV%SPATIAL_STATISTIC=='SURFACE AREA')) THEN
         WRITE(MESSAGE,'(A,A)') 'ERROR: Invalid SPATIAL_STATISTIC specified for gas DEVC ',TRIM(DV%ID)
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (DV%QUANTITY_INDEX(1)>0 .AND. DV%SPATIAL_STATISTIC/='null' .AND. DV%X1<-1.E5_EB) THEN
         WRITE(MESSAGE,'(A,A)') 'ERROR: XB required when SPATIAL_STATISTIC specified for gas DEVC ',TRIM(DV%ID)
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (TRIM(DV%QUANTITY(1))=='NODE PRESSURE DIFFERENCE') THEN
         CALL GET_QUANTITY_INDEX(DV%SMOKEVIEW_LABEL,DV%SMOKEVIEW_BAR_LABEL,DV%QUANTITY_INDEX(1),I_DUM(1),DV%Y_INDEX,DV%Z_INDEX,&
                                 DV%PART_CLASS_INDEX,DV%DUCT_INDEX,DV%NODE_INDEX(2),I_DUM(2),I_DUM(3),'DEVC', &
                                 DV%QUANTITY(1),'null',DV%SPEC_ID,DV%PART_ID,DV%DUCT_ID,DV%NODE_ID(2),'null','null',-1._EB,&
                                 I_DUM(4))
         IF (DV%NODE_INDEX(1)==DV%NODE_INDEX(2)) THEN
            WRITE(MESSAGE,'(A,A)') 'ERROR: NODE PRESSURE DIFFERENCE node 1 = node 2 ',TRIM(DV%ID)
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ENDIF

      IF (OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%INTEGRATED_PARTICLES) DEVC_PARTICLE_FLUX = .TRUE.

   ENDIF QUANTITY_IF

   ! Even if the device is not in a mesh that is handled by the current MPI process, assign its unit.

   DV%QUANTITY(1) = OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%NAME
   IF (DV%UNITS=='null') DV%UNITS = OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%UNITS

   ! Assign properties to the DEVICE array

   DV%T_CHANGE   = 1.E7_EB
   DV%CTRL_INDEX = 0
   DV%T          = T_BEGIN
   DV%TMP_L      = TMPA

   ! COVariance and CORRelation COEFficient STATISTICS requiring QUANTITY2

   QUANTITY2_IF: IF (DV%N_QUANTITY==2) THEN
      IF (DV%RELATIVE) WRITE(MESSAGE,'(A,A)') 'WARNING: RELATIVE not applicable for multi-QUANTITY DEViCe ',TRIM(DV%ID)
      DV%RELATIVE=.FALSE.
      CALL GET_QUANTITY_INDEX(DV%SMOKEVIEW_LABEL,DV%SMOKEVIEW_BAR_LABEL,DV%QUANTITY_INDEX(2),I_DUM(1), &
                              DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,DV%DUCT_INDEX,DV%NODE_INDEX(1),DV%REAC_INDEX,I_DUM(2),&
                             'DEVC',DV%QUANTITY(2),'null',DV%SPEC_ID,DV%PART_ID,DV%DUCT_ID,DV%NODE_ID(1),DV%REAC_ID,'null',&
                             -1._EB,I_DUM(3))
      DV%QUANTITY(2)   = OUTPUT_QUANTITY(DV%QUANTITY_INDEX(2))%NAME
      DV%SMOKEVIEW_LABEL = TRIM(DV%QUANTITY(1))//' '//TRIM(DV%QUANTITY(2))//' '//TRIM(DV%TEMPORAL_STATISTIC)
      DV%SMOKEVIEW_BAR_LABEL = TRIM(OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%SHORT_NAME)//'_'// &
                               TRIM(OUTPUT_QUANTITY(DV%QUANTITY_INDEX(2))%SHORT_NAME)//'_'//TRIM(DV%TEMPORAL_STATISTIC)
      SELECT CASE(DV%TEMPORAL_STATISTIC)
         CASE('COV')
            DV%UNITS = TRIM(OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%UNITS)//'*'//TRIM(OUTPUT_QUANTITY(DV%QUANTITY_INDEX(2))%UNITS)
         CASE('CORRCOEF')
            DV%UNITS = ''
      END SELECT
   ENDIF QUANTITY2_IF

   ! Determine the cell indices of the device

   IF (DV%MESH>0) THEN
      IF (PROCESS(DV%MESH)==MYID) THEN
         M => MESHES(DV%MESH)
         DO NNN=1,DV%N_QUANTITY
            CALL GET_IJK(DV%X,DV%Y,DV%Z,DV%MESH,XI,YJ,ZK,DV%I(NNN),DV%J(NNN),DV%K(NNN))
            IF (OUTPUT_QUANTITY(DV%QUANTITY_INDEX(NNN))%CELL_POSITION==CELL_CENTER) THEN
               DV%I(NNN) = MAX(1,MIN(DV%I(NNN),M%IBAR))
               DV%J(NNN) = MAX(1,MIN(DV%J(NNN),M%JBAR))
               DV%K(NNN) = MAX(1,MIN(DV%K(NNN),M%KBAR))
            ELSEIF (OUTPUT_QUANTITY(DV%QUANTITY_INDEX(NNN))%CELL_POSITION==CELL_FACE) THEN
               SELECT CASE(OUTPUT_QUANTITY(DV%QUANTITY_INDEX(NNN))%IOR)
                  CASE(1) ; DV%I(NNN) = NINT(XI)
                  CASE(2) ; DV%J(NNN) = NINT(YJ)
                  CASE(3) ; DV%K(NNN) = NINT(ZK)
               END SELECT
            ELSEIF (OUTPUT_QUANTITY(DV%QUANTITY_INDEX(NNN))%CELL_POSITION==CELL_EDGE) THEN
               SELECT CASE(OUTPUT_QUANTITY(DV%QUANTITY_INDEX(NNN))%IOR)
                  CASE(1) ; DV%J(NNN) = NINT(YJ) ; DV%K(NNN) = NINT(ZK)
                  CASE(2) ; DV%I(NNN) = NINT(XI) ; DV%K(NNN) = NINT(ZK)
                  CASE(3) ; DV%I(NNN) = NINT(XI) ; DV%J(NNN) = NINT(YJ)
               END SELECT
            ENDIF
         ENDDO
      ELSE
         DV%I=1 ; DV%J=1 ; DV%K=1
      ENDIF
   ENDIF

   ! Initialize histogram

   IF(PROPERTY(DV%PROP_INDEX)%HISTOGRAM) THEN
      ALLOCATE(DV%HISTOGRAM_COUNTS(PROPERTY(DV%PROP_INDEX)%HISTOGRAM_NBINS))
      DV%HISTOGRAM_COUNTS(:)=0._EB
      N_HISTOGRAM=N_HISTOGRAM+1
      MAX_HISTOGRAM_NBINS =MAX(MAX_HISTOGRAM_NBINS,PROPERTY(DV%PROP_INDEX)%HISTOGRAM_NBINS)
   ENDIF

   ! Do initialization of special models

   SPECIAL_QUANTITIES: SELECT CASE (DV%QUANTITY(1))

      CASE ('CHAMBER OBSCURATION')

         IF (DV%PROP_INDEX<1) THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' is a smoke detector and must have a PROP_ID'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (PROPERTY(DV%PROP_INDEX)%Y_INDEX<0 .AND. PROPERTY(DV%PROP_INDEX)%Z_INDEX<0) THEN
            IF (SOOT_INDEX<1) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' is a smoke detector and requires a smoke source'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ELSE
               PROPERTY(DV%PROP_INDEX)%Y_INDEX = SOOT_INDEX
            ENDIF
         ENDIF
         ALLOCATE(DV%T_E(0:1000))
         ALLOCATE(DV%Y_E(0:1000))
         DV%T_E      = T_BEGIN
         DV%Y_E      = 0._EB
         DV%N_T_E    = -1
         DV%Y_C      = 0._EB
         DV%SETPOINT = PROPERTY(DV%PROP_INDEX)%ACTIVATION_OBSCURATION
         IF (PROPERTY(DV%PROP_INDEX)%Y_INDEX>0) DV%Y_INDEX = PROPERTY(DV%PROP_INDEX)%Y_INDEX
         IF (PROPERTY(DV%PROP_INDEX)%Z_INDEX>0) DV%Z_INDEX = PROPERTY(DV%PROP_INDEX)%Z_INDEX

      CASE ('LINK TEMPERATURE','SPRINKLER LINK TEMPERATURE')

         IF (DV%PROP_INDEX<1) THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' must have a PROP_ID'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (PROPERTY(DV%PROP_INDEX)%ACTIVATION_TEMPERATURE <= -273.15_EB) THEN
            WRITE(MESSAGE,'(A,A)') 'ERROR: ACTIVATION_TEMPERATURE needed for PROP ',TRIM(DV%PROP_ID)
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF

         DV%SETPOINT = PROPERTY(DV%PROP_INDEX)%ACTIVATION_TEMPERATURE
         DV%TMP_L    = PROPERTY(DV%PROP_INDEX)%INITIAL_TEMPERATURE

      CASE ('THERMOCOUPLE')

         IF (DV%SPATIAL_STATISTIC/='null') THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' cannot use SPATIAL_STATISTIC'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         DV%TMP_L = PROPERTY(DV%PROP_INDEX)%INITIAL_TEMPERATURE

      CASE ('SOLID DENSITY')

         IF (DV%MATL_ID=='null') THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' must have a MATL_ID'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF

      CASE ('LAYER HEIGHT','UPPER TEMPERATURE','LOWER TEMPERATURE')

         DV%TMP_LOW = TMPA
         DV%TMP_UP  = TMPA
         DV%Z_INT   = 0._EB
         CALL SEARCH_OTHER_MESHES(DV%X1,DV%Y1,DV%Z1,NOM,I,J,K)
         IF (NOM==0) THEN
            WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' is partially outside of the domain'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         DV%LOWEST_MESH = NOM

      CASE ('TRANSMISSION','PATH OBSCURATION')

         IF (DV%MESH>0) THEN
            M  => MESHES(DV%MESH)
            IF (DV%PROP_INDEX>0) THEN
               IF (PROPERTY(DV%PROP_INDEX)%Y_INDEX<1 .AND. PROPERTY(DV%PROP_INDEX)%Z_INDEX<1) THEN
                  IF (SOOT_INDEX<1) THEN
                     WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' is a smoke detector and requires a smoke source'
                     CALL SHUTDOWN(MESSAGE) ; RETURN
                  ELSE
                     PROPERTY(DV%PROP_INDEX)%Y_INDEX = SOOT_INDEX
                  ENDIF
               ENDIF
            ELSE
               IF (SOOT_INDEX <=0) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' is a smoke detector and requires a smoke source'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
            ENDIF
            IF (PROPERTY(DV%PROP_INDEX)%Y_INDEX>0) DV%Y_INDEX = PROPERTY(DV%PROP_INDEX)%Y_INDEX
            IF (PROPERTY(DV%PROP_INDEX)%Z_INDEX>0) DV%Z_INDEX = PROPERTY(DV%PROP_INDEX)%Z_INDEX
            DISTANCE = SQRT((DV%X1-DV%X2)**2 + (DV%Y1-DV%Y2)**2 + (DV%Z1-DV%Z2)**2)
            SCANDISTANCE = 0.0001_EB * DISTANCE
            DX = (DV%X2-DV%X1) * 0.0001_EB
            DY = (DV%Y2-DV%Y1) * 0.0001_EB
            DZ = (DV%Z2-DV%Z1) * 0.0001_EB

            DO NS=1,DV%N_SUBDEVICES
               SDV => DV%SUBDEVICE(NS)
               M => MESHES(SDV%MESH)
               MAXCELLS = 2*MAX(M%IBAR,M%JBAR,M%KBAR)
               ALLOCATE(SDV%I_PATH(0:MAXCELLS))
               ALLOCATE(SDV%J_PATH(0:MAXCELLS))
               ALLOCATE(SDV%K_PATH(0:MAXCELLS))
               ALLOCATE(SDV%D_PATH(MAXCELLS))
               SDV%D_PATH    = 0._EB
               SDV%I_PATH(0) = -1
               SDV%J_PATH(0) = -1
               SDV%K_PATH(0) = -1
               NN = 0
               DO NNN=1,10000
                  XX = DV%X1 + (NNN-0.5_EB)*DX
                  YY = DV%Y1 + (NNN-0.5_EB)*DY
                  ZZ = DV%Z1 + (NNN-0.5_EB)*DZ
                  CALL SEARCH_OTHER_MESHES(XX,YY,ZZ,NOM,I,J,K)
                  IF (NOM/=SDV%MESH) CYCLE
                  IF (NN>0) THEN
                     IF (I/=SDV%I_PATH(NN) .OR. J/=SDV%J_PATH(NN) .OR. K/=SDV%K_PATH(NN)) NN = NN + 1
                  ELSE
                     NN = 1
                  ENDIF
                  SDV%D_PATH(NN) = SDV%D_PATH(NN) + SCANDISTANCE
                  SDV%I_PATH(NN) = I
                  SDV%J_PATH(NN) = J
                  SDV%K_PATH(NN) = K
               ENDDO
               SDV%N_PATH = NN
            ENDDO
         ENDIF

      CASE ('CONTROL')

         DO NN=1,N_CTRL
            IF (CONTROL(NN)%ID==DV%CTRL_ID) DV%CTRL_INDEX = NN
         ENDDO
         IF (DV%CTRL_ID/='null' .AND. DV%CTRL_INDEX<=0) THEN
            WRITE(MESSAGE,'(A,A,A)')  'ERROR: CONTROL ',TRIM(DV%CTRL_ID),' does not exist'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         DV%SETPOINT = 0.5
         DV%TRIP_DIRECTION = 1

      CASE ('CONTROL VALUE')

         DO NN=1,N_CTRL
            IF (CONTROL(NN)%ID==DV%CTRL_ID) DV%CTRL_INDEX = NN
         ENDDO
         IF (DV%CTRL_ID/='null' .AND. DV%CTRL_INDEX<=0) THEN
            WRITE(MESSAGE,'(A,A,A)')  'ERROR: CONTROL ',TRIM(DV%CTRL_ID),' does not exist'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF

      CASE ('ASPIRATION')

         ! Check either for a specified SMOKE SPECies, or if simple chemistry model is being used
         IF (DV%PROP_INDEX>0) THEN
            IF (PROPERTY(DV%PROP_INDEX)%Y_INDEX<1 .AND. PROPERTY(DV%PROP_INDEX)%Z_INDEX<1 .AND. SOOT_INDEX<1) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' is a smoke detector and requires a smoke source'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDIF
         ! Count number of inputs for detector and verify that input is DENSITY with a specified SPEC_ID for smoke
         NNN = 0
         DO NN=1,N_DEVC
            IF (DEVICE(NN)%DEVC_ID==DV%ID) THEN
               IF (DEVICE(NN)%QUANTITY(1)/='DENSITY' .OR. DEVICE(NN)%SPEC_ID=='null') THEN
                  WRITE(MESSAGE,'(A,A,A)')  &
                     'ERROR: DEVICE ',TRIM(DEVICE(NN)%ID)," must use QUANTITY='DENSITY' and a SPEC_ID"
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               NNN = NNN + 1
            ENDIF
         ENDDO
         ALLOCATE(DV%DEVC_INDEX(NNN),STAT=IZERO)
         CALL ChkMemErr('READ','DV%DEVC_INDEX',IZERO)
         DV%DEVC_INDEX = -1
         ALLOCATE(DV%YY_SOOT(NNN,0:100))
         CALL ChkMemErr('READ','DV%YY_SOOT',IZERO)
         DV%YY_SOOT = 0._EB
         ALLOCATE(DV%TIME_ARRAY(0:100))
         CALL ChkMemErr('READ','DV%TIME_ARRAY',IZERO)
         DV%TIME_ARRAY = 0._EB
         DV%TOTAL_FLOWRATE = DV%BYPASS_FLOWRATE
         DV%DT             = -1._EB
         DV%N_INPUTS = NNN
         NNN = 1
         DO NN=1,N_DEVC
            IF (DEVICE(NN)%DEVC_ID==DV%ID) THEN
               DV%TOTAL_FLOWRATE  = DV%TOTAL_FLOWRATE + DEVICE(NN)%FLOWRATE
               DV%DT = MAX(DV%DT,DEVICE(NN)%DELAY)
               IF (NN > N) THEN
                  WRITE(MESSAGE,'(A,A,A)') 'ERROR: ASPIRATION DEVICE ',TRIM(DV%ID),' is not listed after all its inputs'
                  CALL SHUTDOWN(MESSAGE) ; RETURN
               ENDIF
               DV%DEVC_INDEX(NNN)     = NN
               NNN = NNN + 1
            ENDIF
         ENDDO
         DV%DT = DV%DT * 0.01_EB

      CASE ('FED')
         DV%SPATIAL_STATISTIC  = 'null'
         DV%TEMPORAL_STATISTIC = 'TIME INTEGRAL'
         IF (DV%PROP_INDEX>0) THEN
            IF (PROPERTY(DV%PROP_INDEX)%FED_ACTIVITY<1 .AND. PROPERTY(DV%PROP_INDEX)%FED_ACTIVITY>3) THEN
               WRITE(MESSAGE,'(A,A,A)') 'ERROR: DEVC ',TRIM(DV%ID),' is a FED detector and requires an activity'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            DV%FED_ACTIVITY = PROPERTY(DV%PROP_INDEX)%FED_ACTIVITY
         ENDIF

      CASE ('VELOCITY PATCH')
         PATCH_VELOCITY = .TRUE.
         ALLOCATE(DV%DEVC_INDEX(1),STAT=IZERO)
         DV%DEVC_INDEX(1) = 0
         DO NN=1,N_DEVC
            IF (DEVICE(NN)%ID==DV%DEVC_ID) DV%DEVC_INDEX(1) = NN
         ENDDO
         IF (DV%DEVC_INDEX(1)==0) THEN
            WRITE(MESSAGE,'(A)') 'ERROR: A VELOCITY PATCH DEVC line needs a DEVC_ID to control it'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF

   END SELECT SPECIAL_QUANTITIES

   IF (DV%SPATIAL_STATISTIC/='null' .OR. DV%TEMPORAL_STATISTIC/='null') THEN
      CALL CHANGE_UNITS(DV%QUANTITY(1),DV%UNITS,DV%SPATIAL_STATISTIC,DV%TEMPORAL_STATISTIC,LU_ERR)
   ENDIF

   IF (DV%NO_UPDATE_DEVC_ID/='null' .OR. DV%NO_UPDATE_CTRL_ID/='null') &
      CALL SEARCH_CONTROLLER('DEVC',DV%NO_UPDATE_CTRL_ID,DV%NO_UPDATE_DEVC_ID,DV%NO_UPDATE_DEVC_INDEX,DV%NO_UPDATE_CTRL_INDEX,N)

ENDDO PROC_DEVC_LOOP

END SUBROUTINE PROC_DEVC


!> \brief Read in the PROFile namelist lines

SUBROUTINE READ_PROF

INTEGER :: N,NM,MESH_NUMBER,NN,N_PROFO,IOR,FORMAT_INDEX
REAL(EB) :: XYZ(3)
CHARACTER(LABEL_LENGTH) :: QUANTITY,INIT_ID
TYPE (PROFILE_TYPE), POINTER :: PF
NAMELIST /PROF/ FORMAT_INDEX,FYI,ID,INIT_ID,IOR,QUANTITY,XYZ

N_PROF = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_PROF_LOOP: DO
   CALL CHECKREAD('PROF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_PROF_LOOP
   READ(LU_INPUT,NML=PROF,END=11,ERR=12,IOSTAT=IOS)
   N_PROF = N_PROF + 1
   12 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with PROF number ',N_PROF+1,', line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDDO COUNT_PROF_LOOP
11 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (N_PROF==0) RETURN

ALLOCATE(PROFILE(N_PROF),STAT=IZERO)
CALL ChkMemErr('READ','PROFILE',IZERO)

N_PROFO = N_PROF
N       = 0

PROF_LOOP: DO NN=1,N_PROFO

   N = N+1

   FORMAT_INDEX = 1
   IOR  = 0
   INIT_ID = 'null'
   SELECT CASE(N)
      CASE(1:9)     ; WRITE(ID,'(A,I1)') 'PROFILE ',N
      CASE(10:99)   ; WRITE(ID,'(A,I2)') 'PROFILE ',N
      CASE(100:999) ; WRITE(ID,'(A,I3)') 'PROFILE ',N
   END SELECT

   CALL CHECKREAD('PROF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT PROF_LOOP
   READ(LU_INPUT,PROF)

   ! Check for bad PROF quantities or coordinates

   IF (IOR==0 .AND. INIT_ID=='null') THEN
      WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Specify orientation of PROF ' ,NN,' using the parameter IOR'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF

   MESH_NUMBER = 0

   ! If the PROFile has been assigned an orientation (IOR/=0), determine what mesh its XYZ is in. If not in any mesh, reject it.

   IF (IOR/=0) THEN
      MESH_LOOP: DO NM=1,NMESHES
         IF (.NOT.EVACUATION_ONLY(NM)) THEN
            M=>MESHES(NM)
            IF (XYZ(1)>=M%XS .AND. XYZ(1)<=M%XF .AND. XYZ(2)>=M%YS .AND. XYZ(2)<=M%YF .AND. XYZ(3)>=M%ZS .AND. XYZ(3)<=M%ZF) THEN
               IF (ABS(XYZ(1)-M%XS)<TWO_EPSILON_EB) THEN
                  IF (IOR==-1) THEN ; CYCLE MESH_LOOP ; ELSE ; XYZ(1)=XYZ(1)+0.001_EB*(M%XF-M%XS)/REAL(M%IBAR,EB) ; ENDIF
               ENDIF
               IF (ABS(XYZ(1)-M%XF)<TWO_EPSILON_EB) THEN
                  IF (IOR== 1) THEN ; CYCLE MESH_LOOP ; ELSE ; XYZ(1)=XYZ(1)-0.001_EB*(M%XF-M%XS)/REAL(M%IBAR,EB) ; ENDIF
               ENDIF
               IF (ABS(XYZ(2)-M%YS)<TWO_EPSILON_EB) THEN
                  IF (IOR==-2) THEN ; CYCLE MESH_LOOP ; ELSE ; XYZ(2)=XYZ(2)+0.001_EB*(M%YF-M%YS)/REAL(M%JBAR,EB) ; ENDIF
               ENDIF
               IF (ABS(XYZ(2)-M%YF)<TWO_EPSILON_EB) THEN
                  IF (IOR== 2) THEN ; CYCLE MESH_LOOP ; ELSE ; XYZ(2)=XYZ(2)-0.001_EB*(M%YF-M%YS)/REAL(M%JBAR,EB) ; ENDIF
               ENDIF
               IF (ABS(XYZ(3)-M%ZS)<TWO_EPSILON_EB) THEN
                  IF (IOR==-3) THEN ; CYCLE MESH_LOOP ; ELSE ; XYZ(3)=XYZ(3)+0.001_EB*(M%ZF-M%ZS)/REAL(M%KBAR,EB) ; ENDIF
               ENDIF
               IF (ABS(XYZ(3)-M%ZF)<TWO_EPSILON_EB) THEN
                  IF (IOR== 3) THEN ; CYCLE MESH_LOOP ; ELSE ; XYZ(3)=XYZ(3)-0.001_EB*(M%ZF-M%ZS)/REAL(M%KBAR,EB) ; ENDIF
               ENDIF
               MESH_NUMBER = NM
               EXIT MESH_LOOP
            ENDIF
         ENDIF
      ENDDO MESH_LOOP
      IF (MESH_NUMBER==0) THEN  ! No meshes have been found. Throw out this PROFile.
         N      = N-1
         N_PROF = N_PROF-1
         CYCLE PROF_LOOP
      ENDIF
   ENDIF

   ! Assign parameters to the PROFILE array

   PF => PROFILE(N)
   PF%FORMAT_INDEX = FORMAT_INDEX
   PF%ORDINAL      = NN
   PF%INIT_ID      = INIT_ID
   PF%MESH         = MESH_NUMBER
   PF%ID           = ID
   PF%QUANTITY     = QUANTITY
   PF%X            = XYZ(1)
   PF%Y            = XYZ(2)
   PF%Z            = XYZ(3)
   PF%IOR          = IOR

ENDDO PROF_LOOP
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

END SUBROUTINE READ_PROF


!> \brief Read in the ISOsurFace namelist lines

SUBROUTINE READ_ISOF

REAL(EB) :: VALUE(10)
CHARACTER(LABEL_LENGTH) :: QUANTITY,QUANTITY2,SPEC_ID,SPEC_ID2
INTEGER :: N,VELO_INDEX,VELO_INDEX2,SKIP
TYPE(ISOSURFACE_FILE_TYPE), POINTER :: IS=>NULL()
REAL(FB) :: DELTA
NAMELIST /ISOF/ DELTA,FYI,QUANTITY,QUANTITY2,SKIP,SPEC_ID,SPEC_ID2,VALUE,VELO_INDEX,VELO_INDEX2

N_ISOF = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_ISOF_LOOP: DO
   CALL CHECKREAD('ISOF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_ISOF_LOOP
   READ(LU_INPUT,NML=ISOF,END=9,ERR=10,IOSTAT=IOS)
   N_ISOF = N_ISOF + 1
   10 IF (IOS>0) THEN
      WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with ISOF number ',N_ISOF,', line number ',INPUT_FILE_LINE_NUMBER
      CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
ENDDO COUNT_ISOF_LOOP
9 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

ALLOCATE(ISOSURFACE_FILE(N_ISOF),STAT=IZERO)
CALL ChkMemErr('READ','ISOSURFACE_FILE',IZERO)

READ_ISOF_LOOP: DO N=1,N_ISOF
   IS => ISOSURFACE_FILE(N)
   DELTA            = -1.0_FB
   QUANTITY         = 'null'
   QUANTITY2        = 'null'
   SKIP             = 1
   SPEC_ID          = 'null'
   SPEC_ID2         = 'null'
   VALUE            = -999._EB
   VELO_INDEX       = 0
   VELO_INDEX2      = 0

   CALL CHECKREAD('ISOF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_ISOF_LOOP
   READ(LU_INPUT,ISOF)

   IS%DELTA            = DELTA
   IS%VELO_INDEX       = VELO_INDEX
   IS%VELO_INDEX2      = VELO_INDEX2
   IS%SKIP             = SKIP

   CALL GET_QUANTITY_INDEX(IS%SMOKEVIEW_LABEL,IS%SMOKEVIEW_BAR_LABEL,IS%INDEX,I_DUM(1), &
                           IS%Y_INDEX,IS%Z_INDEX,I_DUM(2),I_DUM(3),I_DUM(4),I_DUM(5),I_DUM(6),'ISOF', &
                           QUANTITY,'null',SPEC_ID,'null','null','null','null','null',-1._EB,I_DUM(7))

   IF ( QUANTITY2 /= 'null' ) THEN
      CALL GET_QUANTITY_INDEX(IS%SMOKEVIEW_LABEL2,IS%SMOKEVIEW_BAR_LABEL2,IS%INDEX2,I_DUM(1), &
                           IS%Y_INDEX2,IS%Z_INDEX2,I_DUM(2),I_DUM(3),I_DUM(4),I_DUM(5),I_DUM(6),'ISOF', &
                           QUANTITY2,'null',SPEC_ID2,'null','null','null','null','null',-1._EB,I_DUM(7))
   ENDIF

   VALUE_LOOP: DO I=1,10
      IF (VALUE(I)<=-998._EB) EXIT VALUE_LOOP
      IS%N_VALUES = I
      IS%VALUE(I) = REAL(VALUE(I),FB)
   ENDDO VALUE_LOOP

ENDDO READ_ISOF_LOOP

REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

END SUBROUTINE READ_ISOF


!> \brief Subdivide a grid
!> \details This routine is used to split a slice file into finer and finer sub-regions until at the last step
!> each region is a grid cell I_IND and NI are intially defined to be NI=2, I_IND(1)=1, I_IND(2)=NI_ALL.
!> The first step would be to generate NI=3, I_IND(1), I_IND(2)=INT((1+NI_ALL)/2), I_IND(3)=NI_ALL.
!> This routine is then called multiple times until NI=NI_ALL, I_IND(1)=1, ..., I_IND(NI_ALL)=NI_ALL.

SUBROUTINE SUBDIVIDE_INDICES(I_IND, NI, NI_ALL)

INTEGER, INTENT(INOUT) :: NI
INTEGER, INTENT(IN) :: NI_ALL
INTEGER, INTENT(INOUT), DIMENSION(NI_ALL) :: I_IND
INTEGER, DIMENSION(NI_ALL) :: I_IND_COPY
INTEGER :: I, COUNT, INDEX

COUNT = 1
I_IND_COPY(COUNT) = I_IND(1)
DO I = 2, NI
   IF (I_IND(I)-I_IND(I-1).GT.1) THEN
      COUNT = COUNT + 1
      INDEX = (I_IND(I) + I_IND(I-1))/2
      I_IND_COPY(COUNT) = INDEX
   ENDIF
   COUNT = COUNT + 1
   I_IND_COPY(COUNT) = I_IND(I)
END DO
NI = COUNT
I_IND(1:NI) = I_IND_COPY(1:NI)

END SUBROUTINE SUBDIVIDE_INDICES


!> \brief Generate a permutation vector that rearranges slice file values from a coarse to a fine grid resolution

SUBROUTINE REORDER_SLICEVALS(REORDER_TO_KJI,NI,NJ,NK)

INTEGER, INTENT(IN) :: NI, NJ, NK
INTEGER, INTENT(OUT), DIMENSION(NI*NJ*NK) :: REORDER_TO_KJI

INTEGER, DIMENSION(NI*NJ*NK) :: KJI_TO_REORDER
INTEGER :: I, J, K
INTEGER :: II, JJ, KK
INTEGER :: NI2, NJ2, NK2
INTEGER, DIMENSION(NI) :: NI_LIST
INTEGER, DIMENSION(NJ) :: NJ_LIST
INTEGER, DIMENSION(NK) :: NK_LIST
INTEGER :: COUNT, FINISH, INDEX

KJI_TO_REORDER(1:NI*NJ*NK) = 0
NI2 = 2
NJ2 = 2
NK2 = 2
NI_LIST(1) = 1
NI_LIST(2) = NI
NJ_LIST(1) = 1
NJ_LIST(2) = NJ
NK_LIST(1) = 1
NK_LIST(2) = NK
FINISH = 0

COUNT = 1
! YZ slice planes
IF (NI.EQ.1) THEN
   DO WHILE (FINISH .EQ. 0)
      DO KK = 1, NK2
         K = NK_LIST(KK)
         DO JJ = 1, NJ2
            J = NJ_LIST(JJ)
            INDEX = (K-1)*NJ + J
            IF(KJI_TO_REORDER(INDEX) .EQ. 0) THEN
               KJI_TO_REORDER(INDEX) = COUNT
               COUNT = COUNT + 1
            ENDIF
         END DO
      END DO
      IF (NK2 .EQ. NK .AND. NJ.EQ.NJ2) THEN
         FINISH = 1
      ELSE
         IF(NJ.NE.NJ2) CALL SUBDIVIDE_INDICES(NJ_LIST, NJ2, NJ)
         IF(NK.NE.NK2) CALL SUBDIVIDE_INDICES(NK_LIST, NK2, NK)
      ENDIF
   END DO
! XZ slice planes
ELSE IF(NJ.EQ.1) THEN
   DO WHILE (FINISH .EQ. 0)
      DO KK = 1, NK2
         K = NK_LIST(KK)
         DO II = 1, NI2
            I = NI_LIST(II)
            INDEX = (K-1)*NI + I
            IF(KJI_TO_REORDER(INDEX) .EQ. 0) THEN
               KJI_TO_REORDER(INDEX) = COUNT
               COUNT = COUNT + 1
            ENDIF
         END DO
      END DO
      IF (NK2 .EQ. NK .AND. NI.EQ.NI2) THEN
         FINISH = 1
      ELSE
         IF(NI.NE.NI2) CALL SUBDIVIDE_INDICES(NI_LIST, NI2, NI)
         IF(NK.NE.NK2) CALL SUBDIVIDE_INDICES(NK_LIST, NK2, NK)
      ENDIF
   END DO
! XY slice planes
ELSE IF(NK.EQ.1) THEN
   DO WHILE (FINISH .EQ. 0)
      DO JJ = 1, NJ2
         J = NJ_LIST(JJ)
         DO II = 1, NI2
            I = NI_LIST(II)
            INDEX = (J-1)*NI + I
            IF(KJI_TO_REORDER(INDEX) .EQ. 0) THEN
               KJI_TO_REORDER(INDEX) = COUNT
               COUNT = COUNT + 1
            ENDIF
         END DO
      END DO
      IF (NJ2 .EQ. NJ .AND. NI.EQ.NI2) THEN
         FINISH = 1
      ELSE
         IF(NJ.NE.NJ2) CALL SUBDIVIDE_INDICES(NJ_LIST, NJ2, NJ)
         IF(NI.NE.NI2) CALL SUBDIVIDE_INDICES(NI_LIST, NI2, NI)
      ENDIF
   END DO
ELSE
! this case should never happen because only 2D slices use the MULTI_RES keyword
   DO I = 1, NI*NJ*NK
      REORDER_TO_KJI(I) = I
   END DO
ENDIF
DO I = 1, NI*NJ*NK
   INDEX = KJI_TO_REORDER(I)
   REORDER_TO_KJI(INDEX) = I
END DO
END SUBROUTINE REORDER_SLICEVALS


!> \brief Read the SLiCe File namelist lines

SUBROUTINE READ_SLCF

REAL(EB) :: MAXIMUM_VALUE,MINIMUM_VALUE
REAL(EB) :: AGL_SLICE
INTEGER :: N,NN,NM,MESH_NUMBER,N_SLCF_O,NITER,ITER,VELO_INDEX,IG,TRNF_INDEX,GEOM_INDEX
LOGICAL :: VECTOR,CELL_CENTERED,FACE_CENTERED,EVACUATION,MULTI_RES
CHARACTER(LABEL_LENGTH) :: QUANTITY,SPEC_ID,PART_ID,QUANTITY2,PROP_ID,REAC_ID,SLICETYPE,MATL_ID,TRNF_ID
REAL(EB), PARAMETER :: TOL=1.E-10_EB
REAL(FB) :: RLE_MIN, RLE_MAX
TYPE (SLICE_TYPE), POINTER :: SL
NAMELIST /SLCF/ AGL_SLICE,CELL_CENTERED,DB,EVACUATION,FACE_CENTERED,FYI,ID,MAXIMUM_VALUE,MATL_ID,MESH_NUMBER,&
                MINIMUM_VALUE,MULTI_RES,PART_ID,PBX,PBY,PBZ,PROP_ID,QUANTITY,QUANTITY2,REAC_ID,RLE_MIN,RLE_MAX,SLICETYPE,&
                SPEC_ID,TRNF_ID,VECTOR,VELO_INDEX,XB

MESH_LOOP: DO NM=1,NMESHES

   IF (MYID/=PROCESS(NM)) CYCLE MESH_LOOP

   M=>MESHES(NM)
   CALL POINT_TO_MESH(NM)

   N_SLCF   = 0
   N_SLCF_O = 0
   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   COUNT_SLCF_LOOP: DO
      VECTOR  = .FALSE.
      EVACUATION  = .FALSE.
      MESH_NUMBER=NM
      CALL CHECKREAD('SLCF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT COUNT_SLCF_LOOP
      TRNF_ID = 'null'
      READ(LU_INPUT,NML=SLCF,END=9,ERR=10,IOSTAT=IOS)
      N_SLCF_O = N_SLCF_O + 1
      IF (MESH_NUMBER/=NM) CYCLE COUNT_SLCF_LOOP
      IF (.NOT.EVACUATION_ONLY(NM) .AND.      EVACUATION) CYCLE COUNT_SLCF_LOOP
      IF (     EVACUATION_ONLY(NM) .AND. .NOT.EVACUATION) CYCLE COUNT_SLCF_LOOP
      IF (EVACUATION_ONLY(NM) .AND. .NOT.EVACUATION_SKIP(NM)) CYCLE COUNT_SLCF_LOOP
      N_SLCF  = N_SLCF + 1
      IF (VECTOR .AND. TWO_D) N_SLCF = N_SLCF + 2
      IF (VECTOR .AND. .NOT. TWO_D) N_SLCF = N_SLCF + 3
      10 IF (IOS>0) THEN
         WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with SLCF number ',N_SLCF_O+1,', line number ',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO COUNT_SLCF_LOOP
   9 CONTINUE

   ALLOCATE(M%SLICE(N_SLCF),STAT=IZERO)
   CALL ChkMemErr('READ','ISP1',IZERO)
   CALL POINT_TO_MESH(NM)  ! Reset the pointers after the allocation

   N = 0
   N_TERRAIN_SLCF = 0

   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   SLCF_LOOP: DO NN=1,N_SLCF_O
      QUANTITY  = 'null'
      QUANTITY2 = 'null'
      PBX      = -1.E6_EB
      PBY      = -1.E6_EB
      PBZ      = -1.E6_EB
      DB       = 'null'
      VECTOR   = .FALSE.
      ID       = 'null'
      MESH_NUMBER=NM
      MINIMUM_VALUE = 0._EB
      MAXIMUM_VALUE = 0._EB
      AGL_SLICE = -1._EB
      REAC_ID  = 'null'
      SPEC_ID  = 'null'
      PART_ID  = 'null'
      PROP_ID  = 'null'
      MATL_ID  = 'null'
      TRNF_ID  = 'null'
      TRNF_INDEX = -1
      GEOM_INDEX = -1
      SLICETYPE = 'STRUCTURED'
      CELL_CENTERED = .FALSE.
      FACE_CENTERED = .FALSE.
      EVACUATION  = .FALSE.
      VELO_INDEX = 0
      RLE_MIN = 1.0_FB
      RLE_MAX = 0.0_FB
      MULTI_RES = .FALSE.

      CALL CHECKREAD('SLCF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT SLCF_LOOP
      READ(LU_INPUT,SLCF)
      IF (MESH_NUMBER/=NM) CYCLE SLCF_LOOP
      IF (.NOT.EVACUATION_ONLY(NM) .AND.      EVACUATION) CYCLE SLCF_LOOP
      IF (     EVACUATION_ONLY(NM) .AND. .NOT.EVACUATION) CYCLE SLCF_LOOP
      IF (EVACUATION_ONLY(NM) .AND. .NOT.EVACUATION_SKIP(NM)) CYCLE SLCF_LOOP
      IF (CELL_CENTERED .AND. FACE_CENTERED) FACE_CENTERED = .FALSE.

      IF (TRNF_ID/='null') THEN
         CALL GET_TRNF_INDEX(TRNF_ID, TRNF_INDEX)
         IF ( TRNF_INDEX == -1) THEN
            WRITE(MESSAGE,'(A,A,A)') "ERROR: The &TRNF namelist, ",TRIM(TRNF_ID)," does not exist"
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         SLICETYPE = 'TRANSFORM_GEOM'
         GEOM_INDEX=TRANSFORM(TRNF_INDEX,1)%GEOM_INDEX
      ENDIF

      IF (AGL_SLICE>=0._EB .AND. (CELL_CENTERED .OR. FACE_CENTERED)) THEN
         WRITE(MESSAGE,'(A)') "ERROR: CELL_CENTERED or FACE_CENTERED not allowed with AGL_SLICE"
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (PBX>-1.E5_EB .OR. PBY>-1.E5_EB .OR. PBZ>-1.E5_EB) THEN
         XB(1) = XS
         XB(2) = XF
         XB(3) = YS
         XB(4) = YF
         XB(5) = ZS
         XB(6) = ZF
         IF (PBX>-1.E5_EB) XB(1:2) = PBX
         IF (PBY>-1.E5_EB) XB(3:4) = PBY
         IF (PBZ>-1.E5_EB) XB(5:6) = PBZ
      ENDIF

      IF (DB/='null' .OR. AGL_SLICE>=0._EB) THEN
         XB(1) = XS_MIN
         XB(2) = XF_MAX
         XB(3) = YS_MIN
         XB(4) = YF_MAX
         XB(5) = ZS_MIN
         XB(6) = ZF_MAX
         SELECT CASE(DB)
            CASE('XMIN')
               XB(1:2) = XS_MIN
            CASE('XMID')
               XB(1:2) = 0.5_EB*(XS_MIN+XF_MAX)
            CASE('XMAX')
               XB(1:2) = XF_MAX
            CASE('YMIN')
               XB(3:4) = YS_MIN
            CASE('YMID')
               XB(3:4) = 0.5_EB*(YS_MIN+YF_MAX)
            CASE('YMAX')
               XB(3:4) = YF_MAX
            CASE('ZMIN')
               XB(5:6) = ZS_MIN
            CASE('ZMID')
               XB(5:6) = 0.5_EB*(ZS_MIN+ZF_MAX)
            CASE('ZMAX')
               XB(5:6) = ZF_MAX
         END SELECT
      ENDIF

      CALL CHECK_XB(XB)

      ! Define scalar quantity slices of type "INCLUDE_GEOM" if they cross the bounding box of a GEOM
      ! being handled.
      IF (.NOT. VECTOR) THEN
         IF (PBX>-1.E5_EB .OR. PBY>-1.E5_EB .OR. PBZ>-1.E5_EB) THEN
            DO IG=1,N_GEOMETRY
               ! Check for Slice not crossing GEOM BBox.
               IF (PBX>-1.E5_EB) THEN
                  IF(PBX>GEOMETRY(IG)%GEOM_BOX(HIGH_IND,IAXIS) .OR. PBX<GEOMETRY(IG)%GEOM_BOX( LOW_IND,IAXIS)) CYCLE
               ENDIF
               IF (PBY>-1.E5_EB) THEN
                  IF(PBY>GEOMETRY(IG)%GEOM_BOX(HIGH_IND,JAXIS) .OR. PBY<GEOMETRY(IG)%GEOM_BOX( LOW_IND,JAXIS)) CYCLE
               ENDIF
               IF (PBZ>-1.E5_EB) THEN
                  IF(PBZ>GEOMETRY(IG)%GEOM_BOX(HIGH_IND,KAXIS) .OR. PBZ<GEOMETRY(IG)%GEOM_BOX( LOW_IND,KAXIS)) CYCLE
               ENDIF
               IF(TRIM(SLICETYPE)=='STRUCTURED') SLICETYPE = 'INCLUDE_GEOM'
            ENDDO
         ENDIF
      ENDIF

      XB(1) = MAX(XB(1),XS)
      XB(2) = MIN(XB(2),XF)
      XB(3) = MAX(XB(3),YS)
      XB(4) = MIN(XB(4),YF)
      XB(5) = MAX(XB(5),ZS)
      XB(6) = MIN(XB(6),ZF)

      ! Reject a slice if it is beyond the bounds of the current mesh

      IF (XB(1)>XF .OR. XB(2)<XS .OR. XB(3)>YF .OR. XB(4)<YS .OR. XB(5)>ZF .OR. XB(6)<ZS) THEN
         N_SLCF = N_SLCF - 1
         IF (VECTOR .AND. TWO_D) N_SLCF = N_SLCF - 2
         IF (VECTOR .AND. .NOT. TWO_D) N_SLCF = N_SLCF - 3
         CYCLE SLCF_LOOP
      ENDIF

      ! Process vector quantities

      NITER = 1
      IF (VECTOR .AND. TWO_D) NITER = 3
      IF (VECTOR .AND. .NOT. TWO_D) NITER = 4

      VECTORLOOP: DO ITER=1,NITER
         N = N + 1
         SL=>SLICE(N)
         SL%SLCF_INDEX=NN
         SL%ID = ID
         SL%SLICETYPE = TRIM(SLICETYPE)
         SL%GEOM_INDEX = GEOM_INDEX
         SL%TRNF_INDEX = TRNF_INDEX
         IF ((FACE_CENTERED .OR. CELL_CENTERED) .AND. NITER==1) THEN ! scalar raw data
            DO I=1,IBAR
               IF ( ABS(XB(1)-XC(I)) < 0.5_EB*DX(I) + TOL ) SL%I1 = I
               IF ( ABS(XB(2)-XC(I)) < 0.5_EB*DX(I) + TOL ) SL%I2 = I
            ENDDO
            DO J=1,JBAR
               IF ( ABS(XB(3)-YC(J)) < 0.5_EB*DY(J) + TOL ) SL%J1 = J
               IF ( ABS(XB(4)-YC(J)) < 0.5_EB*DY(J) + TOL ) SL%J2 = J
            ENDDO
            DO K=1,KBAR
               IF ( ABS(XB(5)-ZC(K)) < 0.5_EB*DZ(K) + TOL ) SL%K1 = K
               IF ( ABS(XB(6)-ZC(K)) < 0.5_EB*DZ(K) + TOL ) SL%K2 = K
            ENDDO
            IF (SL%I1<SL%I2) SL%I1=SL%I1-1
            IF (SL%J1<SL%J2) SL%J1=SL%J1-1
            IF (SL%K1<SL%K2) SL%K1=SL%K1-1
         ELSEIF (AGL_SLICE>=0._EB) THEN
            SL%I1 = 0
            SL%I2 = IBAR
            SL%J1 = 0
            SL%J2 = JBAR
            SL%K1 = 1
            SL%K2 = 1
         ELSE
            SL%I1 = NINT( GINV(XB(1)-XS,1,NM)*RDXI )
            SL%I2 = NINT( GINV(XB(2)-XS,1,NM)*RDXI )
            SL%J1 = NINT( GINV(XB(3)-YS,2,NM)*RDETA )
            SL%J2 = NINT( GINV(XB(4)-YS,2,NM)*RDETA )
            SL%K1 = NINT( GINV(XB(5)-ZS,3,NM)*RDZETA )
            SL%K2 = NINT( GINV(XB(6)-ZS,3,NM)*RDZETA )
         ENDIF
         SL%MULTI_RES = MULTI_RES
         IF (MULTI_RES) THEN
            IF (SL%I1 .NE. SL%I2 .AND. SL%J1 .NE. SL%J2 .AND. SL%K1 .NE. SL%K2 ) THEN
               WRITE(MESSAGE,'(A)')  'ERROR: Only 2D slices can use the MULTI_RES option'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            ALLOCATE(SL%REORDER_TO_KJI((SL%I2+1-SL%I1)*(SL%J2+1-SL%J1)*(SL%K2+1-SL%K1)),STAT=IZERO)
            CALL REORDER_SLICEVALS(SL%REORDER_TO_KJI,(SL%I2+1-SL%I1),(SL%J2+1-SL%J1),(SL%K2+1-SL%K1))
         ENDIF
         SL%MINMAX(1) = REAL(MINIMUM_VALUE,FB)
         SL%MINMAX(2) = REAL(MAXIMUM_VALUE,FB)
         IF (ITER==2)                    QUANTITY = 'U-VELOCITY'
         IF (ITER==3 .AND. .NOT. TWO_D)  QUANTITY = 'V-VELOCITY'
         IF (ITER==3 .AND. TWO_D)        QUANTITY = 'W-VELOCITY'
         IF (ITER==4)                    QUANTITY = 'W-VELOCITY'
         SL%RLE_MIN = RLE_MIN
         SL%RLE_MAX = RLE_MAX
         IF (RLE_MAX>RLE_MIN) THEN
            SL%RLE = .TRUE.
         ELSE
            SL%RLE = .FALSE.
         ENDIF
         SL%VELO_INDEX = VELO_INDEX
         CALL GET_QUANTITY_INDEX(SL%SMOKEVIEW_LABEL,SL%SMOKEVIEW_BAR_LABEL,SL%INDEX,SL%INDEX2, &
                                 SL%Y_INDEX,SL%Z_INDEX,SL%PART_INDEX,I_DUM(1),I_DUM(2),SL%REAC_INDEX,SL%MATL_INDEX,'SLCF', &
                                 QUANTITY,QUANTITY2,SPEC_ID,PART_ID,'null','null',REAC_ID,MATL_ID,-1._EB,I_DUM(3),&
                                 SLICETYPE=SLICETYPE)

         ! If the user needs to do a particle flux calculation, detect that here.

         IF (OUTPUT_QUANTITY(SL%INDEX)%INTEGRATED_PARTICLES) SLCF_PARTICLE_FLUX = .TRUE.

         ! For terrain slices, AGL=above ground level

         IF (ITER == 1 .AND. AGL_SLICE > -1._EB) THEN
            SL%TERRAIN_SLICE = .TRUE.
            SL%AGL_SLICE     = AGL_SLICE
            N_TERRAIN_SLCF   = N_TERRAIN_SLCF + 1
         ENDIF
         IF (ITER==2 .OR. ITER==3 .OR. ITER ==4) THEN
            IF (SLICE(N-1)%TERRAIN_SLICE) THEN
               SL%TERRAIN_SLICE =  .TRUE.
               SL%AGL_SLICE     = SLICE(N-1)%AGL_SLICE
               N_TERRAIN_SLCF   = N_TERRAIN_SLCF + 1
            ENDIF
         ENDIF

         SL%CELL_CENTERED = CELL_CENTERED
         SL%FACE_CENTERED = FACE_CENTERED

         ! Check if the slcf PROPERTY exists (for FED_ACTIVITY input)

         SL%PROP_INDEX = 0
         IF (PROP_ID /='null') THEN
            CALL GET_PROPERTY_INDEX(SL%PROP_INDEX,'SLCF',PROP_ID)
         ENDIF

      ENDDO VECTORLOOP

      IF (TRIM(QUANTITY)=='CHEMISTRY SUBITERATIONS') OUTPUT_CHEM_IT = .TRUE.

      IF (TRIM(QUANTITY)=='REAC SOURCE TERM' .OR. TRIM(QUANTITY)=='HRRPUV REAC') REAC_SOURCE_CHECK = .TRUE.

      IF (TRIM(QUANTITY)=='H PRIME' .AND. .NOT.EXTERNAL_BOUNDARY_CORRECTION) THEN
         WRITE(MESSAGE,'(A,I0,A)') 'ERROR: Problem with SCLF ',NN,', H PRIME requires EXTERNAL_BOUNDARY_CORRECTION=T on MISC'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (TRIM(QUANTITY)=='SOLID CELL Q_S') STORE_Q_DOT_PPP_S = .TRUE.

      IF (TRIM(QUANTITY)=='DUDT' .OR. TRIM(QUANTITY)=='DVDT' .OR. TRIM(QUANTITY)=='DWDT') STORE_OLD_VELOCITY=.TRUE.

      IF (TRIM(SLICETYPE)=='CUT_CELLS') THEN
         SL%SMOKEVIEW_LABEL     = 'Cut Cells'
         SL%SMOKEVIEW_BAR_LABEL = 'ccells'
      ENDIF


   ENDDO SLCF_LOOP

   ALLOCATE(M%K_AGL_SLICE(0:IBP1,0:JBP1,N_TERRAIN_SLCF),STAT=IZERO)
   CALL ChkMemErr('READ','K_AGL_SLICE',IZERO)
   M%K_AGL_SLICE = 0
   N = 0
   DO NN = 1,N_SLCF
      SL=>SLICE(NN)
      IF (SL%TERRAIN_SLICE) THEN
        TERRAIN_CASE = .TRUE.
        N = N + 1
        M%K_AGL_SLICE(0:IBP1,0:JBP1,N) =  INT(SL%AGL_SLICE*M%RDZ(1))
        ! Subtract one because bottom of domain will be accounted for when cycling through walls cells
        M%K_AGL_SLICE(0:IBP1,0:JBP1,N) =  MAX(0,M%K_AGL_SLICE(0:IBP1,0:JBP1,N)-1)
      ENDIF
   ENDDO

   N_SLCF_MAX = MAX(N_SLCF_MAX,N_SLCF)

ENDDO MESH_LOOP

END SUBROUTINE READ_SLCF


!> \brief Read the RADF (RADiation File) namelist lines and create special radiation output files

SUBROUTINE READ_RADF

INTEGER :: N,NN,NM,I_STEP,J_STEP,K_STEP
TYPE (RAD_FILE_TYPE), POINTER :: RF
NAMELIST /RADF/ FYI,I_STEP,J_STEP,K_STEP,XB

MESH_LOOP: DO NM=1,NMESHES

   IF (MYID/=PROCESS(NM)) CYCLE MESH_LOOP

   M=>MESHES(NM)
   CALL POINT_TO_MESH(NM)

   N_RADF = 0
   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   COUNT_RADF_LOOP: DO
      CALL CHECKREAD('RADF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT COUNT_RADF_LOOP
      READ(LU_INPUT,NML=RADF,END=9,ERR=10,IOSTAT=IOS)
      IF (EVACUATION_ONLY(NM)) CYCLE COUNT_RADF_LOOP
      N_RADF = N_RADF + 1
      10 IF (IOS>0) THEN
         WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with RADF number ',N_RADF+1,', line number ',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDDO COUNT_RADF_LOOP
   9 CONTINUE

   IF (N_RADF==0) CYCLE MESH_LOOP

   ALLOCATE(M%RAD_FILE(N_RADF),STAT=IZERO) ; CALL ChkMemErr('READ','RAD_FILE',IZERO)
   CALL POINT_TO_MESH(NM)  ! Reset the pointers after the allocation

   N = 0

   REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
   RADF_LOOP: DO NN=1,N_RADF
      XB=-1.E9_EB
      I_STEP = 1
      J_STEP = 1
      K_STEP = 1
      CALL CHECKREAD('RADF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
      IF (IOS==1) EXIT RADF_LOOP
      READ(LU_INPUT,RADF)
      IF (EVACUATION_ONLY(NM)) CYCLE RADF_LOOP

      CALL CHECK_XB(XB)

      XB(1) = MAX(XB(1),XS)
      XB(2) = MIN(XB(2),XF)
      XB(3) = MAX(XB(3),YS)
      XB(4) = MIN(XB(4),YF)
      XB(5) = MAX(XB(5),ZS)
      XB(6) = MIN(XB(6),ZF)

      ! Reject a block if it is beyond the bounds of the current mesh

      IF (XB(1)>XF .OR. XB(2)<XS .OR. XB(3)>YF .OR. XB(4)<YS .OR. XB(5)>ZF .OR. XB(6)<ZS) THEN
         N_RADF = N_RADF - 1
         CYCLE RADF_LOOP
      ENDIF

      N = N+1

      RF=>RAD_FILE(N)

      RF%I_STEP = I_STEP
      RF%J_STEP = J_STEP
      RF%K_STEP = K_STEP

      DO I=0,IBP1    ; IF (XC(I)<XB(1)) RF%I1 = I+1 ; ENDDO
      DO I=IBP1,0,-1 ; IF (XB(2)<XC(I)) RF%I2 = I-1 ; ENDDO
      DO J=0,JBP1    ; IF (YC(J)<XB(3)) RF%J1 = J+1 ; ENDDO
      DO J=JBP1,0,-1 ; IF (XB(4)<YC(J)) RF%J2 = J-1 ; ENDDO
      DO K=0,KBP1    ; IF (ZC(K)<XB(5)) RF%K1 = K+1 ; ENDDO
      DO K=KBP1,0,-1 ; IF (XB(6)<ZC(K)) RF%K2 = K-1 ; ENDDO

      RF%N_POINTS = 0
      DO K=RF%K1,RF%K2,RF%K_STEP
         DO J=RF%J1,RF%J2,RF%J_STEP
            DO I=RF%I1,RF%I2,RF%I_STEP
               RF%N_POINTS = RF%N_POINTS + 1  ! Just count the total number of points to evaluate
            ENDDO
         ENDDO
      ENDDO

   ENDDO RADF_LOOP

ENDDO MESH_LOOP

END SUBROUTINE READ_RADF


!> \brief Read the BNDF (BouNDary File) namelist lines

SUBROUTINE READ_BNDF

USE DEVICE_VARIABLES
USE COMP_FUNCTIONS, ONLY : CHANGE_UNITS
INTEGER :: N, DEBUG
LOGICAL :: CELL_CENTERED
CHARACTER(LABEL_LENGTH) :: QUANTITY,PROP_ID,SPEC_ID,PART_ID,STATISTICS,TEMPORAL_STATISTIC,DUMMY='null',MATL_ID
EQUIVALENCE(STATISTICS,TEMPORAL_STATISTIC)
NAMELIST /BNDF/ CELL_CENTERED,DEBUG,FYI,MATL_ID,PART_ID,PROP_ID,QUANTITY,SPEC_ID,STATISTICS,TEMPORAL_STATISTIC
TYPE(BOUNDARY_FILE_TYPE), POINTER :: BF=>NULL()

N_BNDF = 0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_BNDF_LOOP: DO
   CALL CHECKREAD('BNDF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_BNDF_LOOP
   READ(LU_INPUT,NML=BNDF,END=209,ERR=210,IOSTAT=IOS)
   N_BNDF = N_BNDF + 1
   210 IF (IOS>0) THEN
         WRITE(MESSAGE,'(A,I0,A,I0)') 'ERROR: Problem with BNDF number ',N_BNDF+1,', line number ',INPUT_FILE_LINE_NUMBER
         CALL SHUTDOWN(MESSAGE) ; RETURN
       ENDIF
ENDDO COUNT_BNDF_LOOP
209 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

ALLOCATE(BOUNDARY_FILE(N_BNDF),STAT=IZERO)
CALL ChkMemErr('READ','BOUNDARY_FILE',IZERO)

BNDF_TIME_INTEGRALS = 0

READ_BNDF_LOOP: DO N=1,N_BNDF
   BF => BOUNDARY_FILE(N)
   DEBUG=0
   CELL_CENTERED = .FALSE.
   MATL_ID  = 'null'
   PART_ID  = 'null'
   PROP_ID  = 'null'
   SPEC_ID  = 'null'
   TEMPORAL_STATISTIC = 'null'
   QUANTITY = 'WALL_TEMPERATURE'
   CALL CHECKREAD('BNDF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_BNDF_LOOP
   READ(LU_INPUT,BNDF)

   IF (TRIM(QUANTITY)=='AMPUA_Z' .OR. TRIM(QUANTITY)=='CPUA_Z' .OR. TRIM(QUANTITY)=='MPUA_Z') THEN
      IF (N_LP_ARRAY_INDICES == 0) THEN
         WRITE(MESSAGE,'(A,I0)') 'ERROR: CPUA_Z, MPUA_Z, and AMPUA_Z require liquid droplets. BNDF line ',N
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ELSE
         IF (.NOT. ALL(LAGRANGIAN_PARTICLE_CLASS%LIQUID_DROPLET)) THEN
               WRITE(MESSAGE,'(A,I0)') 'ERROR: CPUA_Z, MPUA_Z, and AMPUA_Z require liquid droplets. BNDF line ',N
               CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
      ENDIF
   ENDIF

   ! Look to see if output QUANTITY exists

   CALL GET_QUANTITY_INDEX(BF%SMOKEVIEW_LABEL,BF%SMOKEVIEW_BAR_LABEL,BF%INDEX,I_DUM(1), &
                           BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,I_DUM(2),I_DUM(3),I_DUM(4),I_DUM(5),'BNDF', &
                           QUANTITY,'null',SPEC_ID,PART_ID,'null','null','null','null',-1._EB,I_DUM(6))
   BF%MATL_ID = MATL_ID

   BF%UNITS = OUTPUT_QUANTITY(BF%INDEX)%UNITS

   ! Assign miscellaneous attributes to the boundary file

   BF%DEBUG = DEBUG
   BF%CELL_CENTERED = CELL_CENTERED

   ! Check to see if PROP_ID exists

   BF%PROP_INDEX = 0
   IF (PROP_ID/='null')  CALL GET_PROPERTY_INDEX(BF%PROP_INDEX,'BNDF',PROP_ID)

   ! Check to see if the QUANTITY is to be time integrated

   IF (TEMPORAL_STATISTIC=='TIME INTEGRAL') THEN
      BNDF_TIME_INTEGRALS = BNDF_TIME_INTEGRALS + 1
      BF%TIME_INTEGRAL_INDEX = BNDF_TIME_INTEGRALS
      CALL CHANGE_UNITS(QUANTITY,BF%UNITS,DUMMY,TEMPORAL_STATISTIC,LU_ERR)
   ENDIF

ENDDO READ_BNDF_LOOP
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

END SUBROUTINE READ_BNDF


!> \brief Check for existing SURF names

SUBROUTINE CHECK_SURF_NAME(NAME,EXISTS)

LOGICAL, INTENT(OUT) :: EXISTS
CHARACTER(*), INTENT(IN) :: NAME
INTEGER :: NS

EXISTS = .FALSE.
DO NS=0,N_SURF
   IF (NAME==SURFACE(NS)%ID) EXISTS = .TRUE.
ENDDO

END SUBROUTINE CHECK_SURF_NAME


!> \brief Define the index and other properties of output quantities

SUBROUTINE GET_QUANTITY_INDEX(SMOKEVIEW_LABEL,SMOKEVIEW_BAR_LABEL,OUTPUT_INDEX,OUTPUT2_INDEX, &
                              Y_INDEX,Z_INDEX,PART_INDEX,DUCT_INDEX,NODE_INDEX,REAC_INDEX,MATL_INDEX,OUTTYPE, &
                              QUANTITY,QUANTITY2,SPEC_ID_IN,PART_ID,DUCT_ID,NODE_ID,REAC_ID,MATL_ID,CELL_L,&
                              DUCT_CELL_INDEX,SLICETYPE)
CHARACTER(*), INTENT(INOUT) :: QUANTITY
CHARACTER(*), INTENT(OUT) :: SMOKEVIEW_LABEL,SMOKEVIEW_BAR_LABEL
CHARACTER(*) :: SPEC_ID_IN,PART_ID,DUCT_ID,NODE_ID
REAL(EB) :: CELL_L
CHARACTER(LABEL_LENGTH) :: SPEC_ID
CHARACTER(*), INTENT(IN) :: OUTTYPE,QUANTITY2,REAC_ID,MATL_ID
CHARACTER(*), OPTIONAL, INTENT(IN) :: SLICETYPE
INTEGER, INTENT(OUT) :: OUTPUT_INDEX,Y_INDEX,Z_INDEX,PART_INDEX,DUCT_INDEX,NODE_INDEX,REAC_INDEX,OUTPUT2_INDEX,MATL_INDEX,&
                        DUCT_CELL_INDEX
INTEGER :: ND,NS,NN,NR,N_PLUS,N_MINUS

! Backward compatibility

IF (QUANTITY=='oxygen') THEN
   QUANTITY    = 'VOLUME FRACTION'
   SPEC_ID_IN  = 'OXYGEN'
ENDIF
IF (QUANTITY=='carbon monoxide') THEN
   QUANTITY    = 'VOLUME FRACTION'
   SPEC_ID_IN  = 'CARBON MONOXIDE'
ENDIF
IF (QUANTITY=='carbon dioxide') THEN
   QUANTITY    = 'VOLUME FRACTION'
   SPEC_ID_IN  = 'CARBON DIOXIDE'
ENDIF
IF (QUANTITY=='soot') THEN
   QUANTITY    = 'VOLUME FRACTION'
   SPEC_ID_IN  = 'SOOT'
ENDIF
IF (QUANTITY=='soot density') THEN
   QUANTITY    = 'DENSITY'
   SPEC_ID_IN  = 'SOOT'
ENDIF
IF (QUANTITY=='fuel') THEN
   QUANTITY    = 'VOLUME FRACTION'
   WRITE(SPEC_ID_IN,'(A)') REACTION(1)%FUEL
ENDIF

IF (TRIM(QUANTITY)/='null') THEN ! If QUANTITY happens to be undefined with the following loop it ends up being
                                 ! erroneously set to the largest negative ND with value different than 'null'.
   DO ND=-N_OUTPUT_QUANTITIES,N_OUTPUT_QUANTITIES
      IF (QUANTITY==OUTPUT_QUANTITY(ND)%OLD_NAME) QUANTITY = OUTPUT_QUANTITY(ND)%NAME
   ENDDO
ENDIF

! Initialize indices

Y_INDEX = -1
Z_INDEX = -1

SPEC_ID = SPEC_ID_IN

IF (QUANTITY=='OPTICAL DENSITY'         .AND. SPEC_ID=='null') SPEC_ID='SOOT'
IF (QUANTITY=='EXTINCTION COEFFICIENT'  .AND. SPEC_ID=='null') SPEC_ID='SOOT'
IF (QUANTITY=='AEROSOL VOLUME FRACTION' .AND. SPEC_ID=='null') SPEC_ID='SOOT'
IF (QUANTITY=='VISIBILITY'              .AND. SPEC_ID=='null') SPEC_ID='SOOT'

PART_INDEX = 0
DUCT_INDEX = 0
DUCT_CELL_INDEX = 0
NODE_INDEX = 0
OUTPUT2_INDEX = 0
REAC_INDEX = 0
MATL_INDEX = 0

! Look for the appropriate SPEC or SMIX index

IF (SPEC_ID/='null') THEN
   CALL GET_SPEC_OR_SMIX_INDEX(SPEC_ID,Y_INDEX,Z_INDEX)
   IF (QUANTITY=='AEROSOL VOLUME FRACTION' .AND. SPEC_ID/='SOOT') THEN
      IF (Z_INDEX<0) THEN
            WRITE(MESSAGE,'(A,A,A)')  'ERROR: SPEC_ID ',TRIM(SPEC_ID),' for AEROSOL VOLUME FRACTION must be a tracked species'
            CALL SHUTDOWN(MESSAGE) ; RETURN
      ELSE
         IF (SPECIES_MIXTURE(Z_INDEX)%SINGLE_SPEC_INDEX<0) THEN
            WRITE(MESSAGE,'(A,A,A)')  'ERROR: SPEC_ID ',TRIM(SPEC_ID),' for AEROSOL VOLUME FRACTION cannot be a lumped species'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ELSE
            IF (.NOT. SPECIES_MIXTURE(Z_INDEX)%DEPOSITING) THEN
               WRITE(MESSAGE,'(A,A,A)')  'ERROR: SPEC_ID ',TRIM(SPEC_ID),' for AEROSOL VOLUME FRACTION is not an AEROSOL'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         ENDIF
      ENDIF
   ENDIF
   IF (Z_INDEX>=0  .AND. Y_INDEX>=1) THEN
      IF(TRIM(QUANTITY)=='DIFFUSIVITY') THEN
         Y_INDEX=-999
      ELSE
         Z_INDEX=-999
      ENDIF
   ENDIF
   IF (Z_INDEX<0 .AND. Y_INDEX<1) THEN
      IF (OUTTYPE=='SMOKE3D') THEN
         OUTPUT_INDEX = 0
         RETURN
      ELSE
         WRITE(MESSAGE,'(A,A,A,A)')  'ERROR: SPEC_ID ',TRIM(SPEC_ID),' is not explicitly specified for QUANTITY ',TRIM(QUANTITY)
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF
   ENDIF
ENDIF

IF (PRESENT(SLICETYPE)) THEN
   IF( (TRIM(SLICETYPE)=='CUT_CELLS' .OR. TRIM(SLICETYPE)=='EXIMBND_FACES') .AND. TRIM(QUANTITY)=='null') THEN
      OUTPUT_INDEX = 0
      RETURN
   ENDIF
ENDIF

! Assign HVAC indexes

IF (DUCT_ID/='null') THEN
   DO ND = 1, N_DUCTS
      IF (DUCT_ID==DUCT(ND)%ID) THEN
         DUCT_INDEX = ND
         EXIT
      ENDIF
   ENDDO
ENDIF

IF (CELL_L > 0._EB) THEN
   IF (DUCT_ID == 'null') THEN
      WRITE(MESSAGE,'(A,A,A,A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),' requires a DUCT_ID'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ELSEIF (CELL_L > DUCT(DUCT_INDEX)%LENGTH) THEN
      WRITE(MESSAGE,'(A,A,A,A)')  'ERROR: CELL_L used for output QUANTITY ',TRIM(QUANTITY),' is outside of DUCT_ID ',&
      TRIM(DUCT_ID)
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   DUCT_CELL_INDEX = MAX(1,NINT(CELL_L/DUCT(DUCT_INDEX)%LENGTH*DUCT(DUCT_INDEX)%N_CELLS))
ENDIF

IF (NODE_ID/='null') THEN
   DO NN = 1, N_DUCTNODES
      IF (NODE_ID==DUCTNODE(NN)%ID) THEN
         NODE_INDEX = NN
         EXIT
      ENDIF
   ENDDO
ENDIF

IF (TRIM(QUANTITY)=='FILTER LOADING') THEN
   Y_INDEX = -999
   DO NS = 1,N_TRACKED_SPECIES
      IF (TRIM(SPECIES_MIXTURE(NS)%ID)==TRIM(SPEC_ID)) THEN
         Z_INDEX = NS
         EXIT
      ENDIF
   ENDDO
   IF (Z_INDEX<0) THEN
      WRITE(MESSAGE,'(A,A,A)')  'ERROR: FILTER LOADING. ',TRIM(SPEC_ID),' is not a tracked species'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDIF


IF (TRIM(QUANTITY)=='EQUILIBRIUM VAPOR FRACTION' .OR. TRIM(QUANTITY)=='EQUILIBRIUM TEMPERATURE') THEN
   Y_INDEX = -999
   DO NS = 1,N_TRACKED_SPECIES
      IF (TRIM(SPECIES_MIXTURE(NS)%ID)==TRIM(SPEC_ID)) THEN
         Z_INDEX = NS
         EXIT
      ENDIF
   ENDDO
   IF (Z_INDEX<0) THEN
      WRITE(MESSAGE,'(A,A,A)')  'ERROR: EQUILIBRIUM VAPOR FRACTION. ',TRIM(SPEC_ID),' is not a tracked species'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   IF (.NOT. SPECIES_MIXTURE(Z_INDEX)%EVAPORATING) THEN
      WRITE(MESSAGE,'(A,A,A)')  'ERROR: EQUILIBRIUM VAPOR FRACTION. ',TRIM(SPEC_ID),' is not an evaporating species'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDIF

IF (TRIM(QUANTITY)=='MIXTURE FRACTION') THEN
   IF (N_REACTIONS/=1) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: MIXTURE FRACTION requires one and only one REAC input'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   N_PLUS = 0
   N_MINUS = 0
   DO NN = 1,N_TRACKED_SPECIES
      IF (REACTION(1)%NU(NN) > 0)  THEN
         N_PLUS = N_PLUS + 1
         Z_INDEX = NN
      ELSEIF (REACTION(1)%NU(NN) < 0)  THEN
         N_MINUS = N_MINUS + 1
      ENDIF
   ENDDO
   IF (N_PLUS/=1 .AND. N_MINUS/=2) THEN
      WRITE(MESSAGE,'(A)') 'ERROR: MIXTURE FRACTION requires REAC of the form A + B -> C'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDIF

IF (TRIM(QUANTITY)=='HRRPUV REAC') THEN
   IF (TRIM(REAC_ID)=='null') THEN
      WRITE(MESSAGE,'(A)') 'ERROR: HRRPUV REAC requires a REAC_ID'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
   DO NR = 1,N_REACTIONS
      IF (TRIM(REAC_ID)==TRIM(REACTION(NR)%ID)) REAC_INDEX = NR
   ENDDO
   IF (REAC_INDEX==0) THEN
      WRITE(MESSAGE,'(3A)') 'ERROR: REAC_ID ',TRIM(REAC_ID),' not found for HRRPUV REAC'
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDIF

! Assigne MATL_INDEX when MATL_ID is specified

IF (MATL_ID/='null') THEN
   DO NN = 1,N_MATL
      IF (TRIM(MATL_ID)==TRIM(MATERIAL(NN)%ID)) MATL_INDEX = NN
   ENDDO
ENDIF

! Assign PART_INDEX when PART_ID is specified

IF (PART_ID/='null') THEN
   DO NS=1,N_LAGRANGIAN_CLASSES
      IF (PART_ID==LAGRANGIAN_PARTICLE_CLASS(NS)%ID) THEN
         PART_INDEX = NS
         EXIT
      ENDIF
   ENDDO
ENDIF

! Loop over all possible output quantities and assign an index number to match the desired QUANTITY
DO ND=-N_OUTPUT_QUANTITIES,N_OUTPUT_QUANTITIES
   IF (OUTPUT_QUANTITY(ND)%NAME=='null') CYCLE
   IF (QUANTITY2==OUTPUT_QUANTITY(ND)%NAME) THEN

      OUTPUT2_INDEX=ND

      IF (OUTPUT_QUANTITY(ND)%SPEC_ID_REQUIRED .AND. (Y_INDEX<1 .AND. Z_INDEX<0)) THEN
         WRITE(MESSAGE,'(3A)')  'ERROR: Output QUANTITY2 ',TRIM(QUANTITY2),' requires a SPEC_ID'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      ! QUANTITY2 only works with SLCF at the moment
      IF (.NOT.OUTPUT_QUANTITY(ND)%SLCF_APPROPRIATE) THEN
          WRITE(MESSAGE,'(3A)')  'ERROR: The QUANTITY2 ',TRIM(QUANTITY2),' is not appropriate for SLCF'
          CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

   ENDIF
ENDDO

QUANTITY_INDEX_LOOP: DO ND=-N_OUTPUT_QUANTITIES,N_OUTPUT_QUANTITIES

   QUANTITY_IF:IF (QUANTITY==OUTPUT_QUANTITY(ND)%NAME) THEN

      OUTPUT_INDEX = ND

      IF (OUTPUT_QUANTITY(ND)%QUANTITY2_REQUIRED .AND. OUTPUT2_INDEX==0) THEN
         WRITE(MESSAGE,'(3A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),' requires a QUANTITY2'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (OUTPUT_QUANTITY(ND)%SPEC_ID_REQUIRED .AND. (Y_INDEX<1 .AND. Z_INDEX<0)) THEN
         IF (SPEC_ID=='null') THEN
            WRITE(MESSAGE,'(3A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),' requires a SPEC_ID'
         ELSE
            WRITE(MESSAGE,'(5A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),'. SPEC_ID ',TRIM(SPEC_ID),' not found.'
         ENDIF
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (OUTPUT_QUANTITY(ND)%PART_ID_REQUIRED .AND. PART_INDEX<1) THEN
         IF (PART_ID=='null') THEN
            WRITE(MESSAGE,'(3A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),' requires a PART_ID'
         ELSE
            WRITE(MESSAGE,'(5A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),'. PART_ID ',TRIM(PART_ID),' not found.'
         ENDIF
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (OUTPUT_QUANTITY(ND)%DUCT_ID_REQUIRED .AND. DUCT_INDEX<1) THEN
         IF (DUCT_ID=='null') THEN
            WRITE(MESSAGE,'(3A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),' requires a DUCT_ID'
         ELSE
            WRITE(MESSAGE,'(5A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),'. DUCT_ID ',TRIM(DUCT_ID),' not found.'
         ENDIF
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (OUTPUT_QUANTITY(ND)%CELL_L_REQUIRED .AND. DUCT_CELL_INDEX<1) THEN
         IF (DUCT_ID=='null') THEN
            WRITE(MESSAGE,'(3A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),' requires a positive CELL_L'
         ELSE
            WRITE(MESSAGE,'(5A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),' in DUCT_ID ',TRIM(DUCT_ID),&
            ' requires a positive CELL_L'
         ENDIF
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (OUTPUT_QUANTITY(ND)%CELL_L_REQUIRED .AND. (HVAC_MASS_TRANSPORT .NEQV. .TRUE.)) THEN
         WRITE(MESSAGE,'(5A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),' in DUCT_ID ',TRIM(DUCT_ID),&
         ' requires HVAC_MASS_TRANSPORT to be set on MISC'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (OUTPUT_QUANTITY(ND)%NODE_ID_REQUIRED .AND. NODE_INDEX<1) THEN
         IF (NODE_ID=='null') THEN
            WRITE(MESSAGE,'(3A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),' requires a NODE_ID'
         ELSE
            WRITE(MESSAGE,'(5A)')  'ERROR: Output QUANTITY ',TRIM(QUANTITY),'. NODE_ID ',TRIM(NODE_ID),' not found.'
         ENDIF
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (( QUANTITY=='RELATIVE HUMIDITY' .OR. QUANTITY=='HUMIDITY').AND. H2O_INDEX==0) THEN
         WRITE(MESSAGE,'(A)')  'ERROR: RELATIVE HUMIDITY and HUMIDITY require SPEC=WATER VAPOR'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      END IF

      IF (TRIM(QUANTITY)=='DIFFUSIVITY' .AND. SIM_MODE==DNS_MODE .AND. Z_INDEX < 0) THEN
         WRITE(MESSAGE,'(A)')  'ERROR: DIFFUSIVITY requires a tracked species SPEC_ID when using DNS'
         CALL SHUTDOWN(MESSAGE) ; RETURN
      ENDIF

      IF (TRIM(QUANTITY)=='SURFACE DEPOSITION') THEN
         IF (Z_INDEX==0) THEN
            WRITE(MESSAGE,'(A)')  'ERROR: Cannot select background species for deposition'
            CALL SHUTDOWN(MESSAGE) ; RETURN
         ENDIF
         IF (Y_INDEX > 0) THEN
            IF (SPECIES(Y_INDEX)%MODE /= AEROSOL_SPECIES) THEN
               WRITE(MESSAGE,'(A,A,A)')'ERROR: SURFACE DEPOSITION for ',TRIM(SPEC_ID),' is not an aerosol species'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (SPECIES(Y_INDEX)%AWM_INDEX < 0) THEN
               N_SURFACE_DENSITY_SPECIES = N_SURFACE_DENSITY_SPECIES + 1
               SPECIES(Y_INDEX)%AWM_INDEX = N_SURFACE_DENSITY_SPECIES
            ENDIF
         ELSE
            IF(.NOT. SPECIES_MIXTURE(Z_INDEX)%DEPOSITING) THEN
               WRITE(MESSAGE,'(A,A,A)')'ERROR: SURFACE DEPOSITION for ',TRIM(SPEC_ID),' is not an aerosol tracked species'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (SPECIES_MIXTURE(Z_INDEX)%AWM_INDEX < 0) THEN
               N_SURFACE_DENSITY_SPECIES = N_SURFACE_DENSITY_SPECIES + 1
               SPECIES_MIXTURE(Z_INDEX)%AWM_INDEX = N_SURFACE_DENSITY_SPECIES
            ENDIF
         ENDIF
      ENDIF

      IF (TRIM(QUANTITY)=='MPUV_Z' .OR. TRIM(QUANTITY)=='ADD_Z' .OR. TRIM(QUANTITY)=='ADT_Z' .OR. TRIM(QUANTITY)=='ADA_Z' .OR. &
          TRIM(QUANTITY)=='QABS_Z' .OR. TRIM(QUANTITY)=='QSCA_Z' .OR. TRIM(QUANTITY)=='MPUA_Z' .OR. TRIM(QUANTITY)=='CPUA_Z' .OR. &
          TRIM(QUANTITY)=='AMPUA_Z') THEN
         IF (N_LAGRANGIAN_CLASSES==0) THEN
            WRITE(MESSAGE,'(3A)')  'ERROR: The QUANTITY ',TRIM(QUANTITY),' requires liquid droplets'
            CALL SHUTDOWN(MESSAGE)             ; RETURN
         ELSE
            IF (.NOT. ALL(LAGRANGIAN_PARTICLE_CLASS%LIQUID_DROPLET)) THEN
               WRITE(MESSAGE,'(3A)')  'ERROR: The QUANTITY ',TRIM(QUANTITY),' requires liquid droplets'
               CALL SHUTDOWN(MESSAGE)             ; RETURN
            ENDIF
         ENDIF
      ENDIF

      SELECT CASE (TRIM(OUTTYPE))
         CASE ('SLCF')
            ! Throw out bad slices
            IF (.NOT. OUTPUT_QUANTITY(ND)%SLCF_APPROPRIATE) THEN
               WRITE(MESSAGE,'(3A)')  'ERROR: The QUANTITY ',TRIM(QUANTITY),' is not appropriate for SLCF'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         CASE ('DEVC')
            IF (.NOT.OUTPUT_QUANTITY(ND)%DEVC_APPROPRIATE) THEN
               WRITE(MESSAGE,'(3A)')  'ERROR: The QUANTITY ',TRIM(QUANTITY),' is not appropriate for DEVC'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (QUANTITY=='AMPUA' .OR. QUANTITY=='AMPUA_Z') ACCUMULATE_WATER = .TRUE.
         CASE ('PART')
            IF (.NOT. OUTPUT_QUANTITY(ND)%PART_APPROPRIATE) THEN
               WRITE(MESSAGE,'(3A)') 'ERROR: ',TRIM(QUANTITY),' is not a particle output QUANTITY'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         CASE ('BNDF')
            IF (.NOT. OUTPUT_QUANTITY(ND)%BNDF_APPROPRIATE) THEN
               WRITE(MESSAGE,'(3A)')  'ERROR: The QUANTITY ',TRIM(QUANTITY),' is not appropriate for BNDF'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
            IF (QUANTITY=='AMPUA' .OR. QUANTITY=='AMPUA_Z') ACCUMULATE_WATER = .TRUE.
         CASE('ISOF')
            IF (.NOT.OUTPUT_QUANTITY(ND)%ISOF_APPROPRIATE) THEN
               WRITE(MESSAGE,'(3A)')  'ERROR: ISOF quantity ',TRIM(QUANTITY),' not appropriate for isosurface'
               CALL SHUTDOWN(MESSAGE) ; RETURN
            ENDIF
         CASE ('PLOT3D')
             IF (OUTPUT_QUANTITY(ND)%SOLID_PHASE) THEN
                WRITE(MESSAGE,'(5A)') 'ERROR: ',TRIM(OUTTYPE),'_QUANTITY ',TRIM(QUANTITY), ' not appropriate for gas phase'
                CALL SHUTDOWN(MESSAGE) ; RETURN
             ENDIF
             IF (.NOT.OUTPUT_QUANTITY(ND)%SLCF_APPROPRIATE) THEN
                WRITE(MESSAGE,'(5A)') 'ERROR: ',TRIM(OUTTYPE),'_QUANTITY ',TRIM(QUANTITY), ' not appropriate for Plot3D'
                CALL SHUTDOWN(MESSAGE) ; RETURN
             ENDIF
         CASE DEFAULT
      END SELECT

      ! Assign Smokeview Label

      IF (Z_INDEX>=0) THEN
         IF (TRIM(QUANTITY)=='MIXTURE FRACTION') THEN
            SMOKEVIEW_LABEL = TRIM(QUANTITY)
            SMOKEVIEW_BAR_LABEL = TRIM(OUTPUT_QUANTITY(ND)%SHORT_NAME)
         ELSE
            SMOKEVIEW_LABEL = TRIM(SPECIES_MIXTURE(Z_INDEX)%ID)//' '//TRIM(QUANTITY)
            SMOKEVIEW_BAR_LABEL = TRIM(OUTPUT_QUANTITY(ND)%SHORT_NAME)//'_'//TRIM(SPECIES_MIXTURE(Z_INDEX)%ID)
         ENDIF
      ELSEIF (Y_INDEX>0) THEN
         SMOKEVIEW_LABEL = TRIM(SPECIES(Y_INDEX)%ID)//' '//TRIM(QUANTITY)
         SMOKEVIEW_BAR_LABEL = TRIM(OUTPUT_QUANTITY(ND)%SHORT_NAME)//'_'//TRIM(SPECIES(Y_INDEX)%FORMULA)
      ELSEIF (PART_INDEX>0) THEN
         SMOKEVIEW_LABEL = TRIM(LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)%ID)//' '//TRIM(QUANTITY)
         SMOKEVIEW_BAR_LABEL = TRIM(OUTPUT_QUANTITY(ND)%SHORT_NAME)
      ELSEIF (OUTPUT2_INDEX/=0) THEN
         SMOKEVIEW_LABEL = TRIM(QUANTITY)//' '//TRIM(QUANTITY2)
         SMOKEVIEW_BAR_LABEL = TRIM(OUTPUT_QUANTITY(ND)%SHORT_NAME)//'_'//TRIM(OUTPUT_QUANTITY(OUTPUT2_INDEX)%SHORT_NAME)
      ELSEIF (REAC_INDEX/=0) THEN
         SMOKEVIEW_LABEL = TRIM(QUANTITY)//' '//TRIM(REACTION(REAC_INDEX)%ID)
         SMOKEVIEW_BAR_LABEL = TRIM(OUTPUT_QUANTITY(ND)%SHORT_NAME)//'_'//TRIM(REACTION(REAC_INDEX)%ID)
      ELSEIF (MATL_INDEX/=0) THEN
         SMOKEVIEW_LABEL = TRIM(QUANTITY)//' '//TRIM(MATERIAL(MATL_INDEX)%ID)
         SMOKEVIEW_BAR_LABEL = TRIM(OUTPUT_QUANTITY(ND)%SHORT_NAME)//'_'//TRIM(MATERIAL(MATL_INDEX)%ID)
      ELSE
         SMOKEVIEW_LABEL = TRIM(QUANTITY)
         SMOKEVIEW_BAR_LABEL = TRIM(OUTPUT_QUANTITY(ND)%SHORT_NAME)
      ENDIF

      RETURN
   ENDIF QUANTITY_IF

ENDDO QUANTITY_INDEX_LOOP

! If no match for desired QUANTITY is found, stop the job

WRITE(MESSAGE,'(5A)') 'ERROR: ',TRIM(OUTTYPE),' QUANTITY ',TRIM(QUANTITY), ' not found'
CALL SHUTDOWN(MESSAGE) ; RETURN

END SUBROUTINE GET_QUANTITY_INDEX


!> \brief Find the appropriate SPEC or SMIX index for the given SPEC_ID

SUBROUTINE GET_SPEC_OR_SMIX_INDEX(SPEC_ID,Y_INDX,Z_INDX)

CHARACTER(*), INTENT(IN) :: SPEC_ID
INTEGER, INTENT(OUT) :: Y_INDX,Z_INDX
INTEGER :: NS

Y_INDX = -999
Z_INDX = -999

DO NS=1,N_SPECIES
   IF (TRIM(SPEC_ID)==TRIM(SPECIES(NS)%ID)) THEN
      Y_INDX = NS
      EXIT
    ENDIF
ENDDO

DO NS=1,N_TRACKED_SPECIES
   IF (TRIM(SPEC_ID)==TRIM(SPECIES_MIXTURE(NS)%ID)) THEN
      Z_INDX = NS
      RETURN
   ENDIF
ENDDO

END SUBROUTINE GET_SPEC_OR_SMIX_INDEX



SUBROUTINE GET_PROPERTY_INDEX(P_INDEX,OUTTYPE,PROP_ID)

USE DEVICE_VARIABLES
CHARACTER(*), INTENT(IN) :: PROP_ID
CHARACTER(*), INTENT(IN) :: OUTTYPE
INTEGER, INTENT(INOUT) :: P_INDEX
INTEGER :: NN

DO NN=1,N_PROP
  IF (PROP_ID==PROPERTY(NN)%ID) THEN
     P_INDEX = NN
     SELECT CASE (TRIM(OUTTYPE))
        CASE ('SLCF')
        CASE ('DEVC')
        CASE ('PART')
        CASE ('OBST')
        CASE ('BNDF')
        CASE ('PLOT3D')
        CASE DEFAULT
     END SELECT
     RETURN
  ENDIF
ENDDO

WRITE(MESSAGE,'(5A)')  'ERROR: ',TRIM(OUTTYPE),' PROP_ID ',TRIM(PROP_ID),' not found'
CALL SHUTDOWN(MESSAGE) ; RETURN

END SUBROUTINE GET_PROPERTY_INDEX


!> \brief Read the CSVF namelist lines

SUBROUTINE READ_CSVF

USE OUTPUT_DATA
CHARACTER(255) :: CSVFILE,UVWFILE,UVWFILE_NM
LOGICAL :: PER_MESH
INTEGER :: NM
NAMELIST /CSVF/ CSVFILE,PER_MESH,UVWFILE

N_CSVF=0
REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0
COUNT_CSVF_LOOP: DO
   CALL CHECKREAD('CSVF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT COUNT_CSVF_LOOP
   READ(LU_INPUT,NML=CSVF,END=16,ERR=17,IOSTAT=IOS)
   N_CSVF=N_CSVF+1
   16 IF (IOS>0) THEN ; CALL SHUTDOWN('ERROR: problem with CSVF line') ; RETURN ; ENDIF
ENDDO COUNT_CSVF_LOOP
17 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

IF (N_CSVF==0) RETURN

! Set defaults

CSVFILE  = 'null'
UVWFILE  = 'null'
PER_MESH = .FALSE.

! Allocate CSVFINFO array

ALLOCATE(CSVFINFO(MAX(N_CSVF,NMESHES)),STAT=IZERO)
CALL ChkMemErr('READ','CSVF',IZERO)

READ_CSVF_LOOP: DO I=1,N_CSVF

   CALL CHECKREAD('CSVF',LU_INPUT,IOS)  ; IF (STOP_STATUS==SETUP_STOP) RETURN
   IF (IOS==1) EXIT READ_CSVF_LOOP

   ! Read the CSVF line

   READ(LU_INPUT,CSVF,END=37)

   CSVFINFO(I)%CSVFILE = TRIM(CSVFILE)
   IF (TRIM(UVWFILE)/='null' .AND. I>NMESHES) THEN
      CALL SHUTDOWN('Problem with CSVF line: UVWFILE must be in order with MESH.') ; RETURN
   ELSE
      CSVFINFO(I)%UVWFILE = UVWFILE
      UVW_RESTART = .TRUE.
   ENDIF

ENDDO READ_CSVF_LOOP

! Read UVWFILE per MESH

IF (TRIM(UVWFILE)/='null' .AND. PER_MESH) THEN
   DO NM=1,NMESHES
      WRITE(UVWFILE_NM,'(A,I3.3,A)') TRIM(UVWFILE),NM,'.csv'
      CSVFINFO(NM)%UVWFILE = UVWFILE_NM
   ENDDO
   UVW_RESTART = .TRUE.
ENDIF

37 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0

END SUBROUTINE READ_CSVF


!> \brief Calculate the heat of vaporization of water

SUBROUTINE CALC_H2O_HV

USE PROPERTY_DATA, ONLY: JANAF_TABLE,JANAF_TABLE_LIQUID
CHARACTER(LABEL_LENGTH) :: WATER_VAPOR='WATER VAPOR'
INTEGER :: I
REAL(EB) :: CP_G,CP_G_O,CP_L,CP_L_O,H_G,H_L,H_G_0,H_L_0,G_F,RCON,H_V,T_R,T_M,T_B,DENSITY,MU_LIQUID,K_LIQUID,BETA_LIQUID
REAL(EB) :: H_L_3,H_L_4,H_G_3,H_G_4
LOGICAL :: FUEL

DO I=0,5000
   CALL JANAF_TABLE (I,CP_G,H_G_0,WATER_VAPOR,RCON,FUEL,G_F)
   CALL JANAF_TABLE_LIQUID (I,CP_L,H_V,H_L_0,T_R,T_M,T_B,WATER_VAPOR,FUEL,DENSITY,MU_LIQUID,K_LIQUID,BETA_LIQUID)
   IF (I==0) THEN
      H_G = H_G_0
      H_L = H_L_0
   ELSE
      H_G = H_G + 0.5_EB*(CP_G+CP_G_O)
      H_L = H_L + 0.5_EB*(CP_L+CP_L_O)
   ENDIF
   H_V_H2O(I) = H_G-H_L
   CP_G_O=CP_G
   CP_L_O=CP_L
   IF (I==273) THEN
      H_G_3 = H_G
      H_L_3 = H_L
   ENDIF
   IF (I==274) THEN
      H_G_4 = H_G
      H_L_4 = H_L
   ENDIF
END DO
H_G = (H_G_3/273._EB+0.15_EB*(H_G_4/274._EB-H_G_3/273._EB))*273.15_EB
H_L = H_L_3+0.15_EB*(H_L_4-H_L_3)
H_V_H2O = H_V_H2O - ((H_G-H_L) - H_V_H2O(273)-0.15_EB*(H_V_H2O(274)-H_V_H2O(273)))

END SUBROUTINE CALC_H2O_HV


END MODULE READ_INPUT
